!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE SUFILNAM 1
use mod4dv
, only : l4dvar
USE procs_topo,ONLY : myid
IMPLICIT NONE
#if defined (DOC)
*s/r SUFILNAM -INITIALZE INPUT/OUTPUT FILE NAMES FOR 3DVAR.
*
************************************************************************
*
*Author . P. KOCLAS CMC/CMSV TEL. 4628
* Revision:
* . J. St-James *CMC/CMSV JUNE 1997
* - add a new key for the file containing the
* lat, lon positions of obs. (NINCREM = 2)
* - documentation
* . P. KOCLAS *CMC/CMDA JAN 2000
* -ADD SATWIND (SW) FAMILY
* . S. Pellerin *ARMA/AES march 2000
* - Output stat file
* . S. Pellerin *ARMA/SMC May 2000
* - Illimination of NAMBRN for I/O file name
* CCARD only from now on
* - Logical unit cleanup
* . S. Pellerin *ARMA/SMC nov. 2001
* - Introdution of key 'exc4dv' controling
* 3Dvar mode / 4Dvar exchange directory
* . N. Wagneur *MSC/CMC June 2002
* - Addition of GOES ('GO') familiy
* . J. St-James *CMDA/SMC - July 2003
* - Add Profiler ('PR') family
* . JM Belanger *MSC/CMC Nov 2003
* - Addition of QUIKSCAT ('SC') familiy
* . J.M. Aparicio *ARMA/MSC* October 2006
* - Adapt for GPSRO
* . A. Beaulne *CMDA/SMC - August 2007
* - Put a dot after the AX_## of all families
* in CLE variable
* . Bin He *ARMA/SMC - Apr. 2008
* - Reading multiple trial files.
* Note that asumming Units starting from 550 are
* reserved for trial files.
* . S. Pellerin, ARMA, August 2008
* - Use of fnom to generate automatic logical unit
* numbers of multiple trial files
* . Bin HE , ARMA, Oct. 2008
* - Hardcoded the name of trial files as "TRLM_??".
* Use "INQUIRE" to detect the existance of these trial files.
* Removed the namelist NAMTRIAL from "comlun.cdk"
* . Bin He , ARMA, Jan. 2009 .
* - Implemented MPI version .
*
*
************************************************************************
#endif
*
#include "comct0.cdk"
#include "comlun.cdk"
#include "comvfiles.cdk"
INTEGER INFIL,IPOSIT,IER,INBLKS,II,I,JJ
INTEGER FNOM,FCLOS,FSTOUV,NUMBLKS,K
PARAMETER(INFIL=129)
c
CHARACTER *128 CLVALU(INFIL),CFAMI(INFIL)
C
C
CHARACTER *2 flnum
CHARACTER *9 trialfile
CHARACTER *36 OneSatOBS
INTEGER ier1,ier2,istatus ,chlength
LOGICAL ltrial,isExist_L
************************************************************************
*
DATA CFAMI /'ST','TR','ST','ST','ST','ST','ST','ST','ST'
& ,8*'UA',8*'HU',8*'ST',8*'AI',8*'SF',8*'MI',8*'TO',8*'SW'
& ,8*'OZ',8*'AC',8*'GO',8*'SC',8*'PR',8*'RO',8*'GP'/
************************************************************************
IPOSIT=0
c
CLVALU(1) = './flnml'
CLVALU(2) = './obscov'
CLVALU(3) = './trlm'
CLVALU(4) = './anlm'
CLVALU(5) = './glbcov'
CLVALU(6) = './rebm'
CLVALU(7) = './rehm'
CLVALU(8) = ''
CLVALU(9) = './preconin'
CLVALU(10) = 'brpuan'
CLVALU(11) = 'brpuas'
CLVALU(12) = 'brpai'
CLVALU(13) = 'brpain'
CLVALU(14) = 'brpais'
CLVALU(15) = 'brpsfc'
CLVALU(16) = 'brpsf'
CLVALU(17) = 'brptov'
CLVALU(18) = 'brpsw'
CLVALU(19) = 'brpswgoes9'
CLVALU(20) = 'brpswgoese'
CLVALU(21) = 'brpswgoesw'
CLVALU(22) = 'brpswmodis'
CLVALU(23) = 'brpswmtsate'
CLVALU(24) = 'brpswmtsatw'
CLVALU(25) = 'brpgo'
CLVALU(26) = 'brpsc'
CLVALU(27) = 'brppr'
CLVALU(28) = 'brpro'
CLVALU(29) = 'brphum'
CLVALU(30) = 'brpsat'
CLVALU(31) = 'brpssm'
CLVALU(32) = 'brpo3'
CLVALU(33) = 'brpoz'
CLVALU(34) = 'brpgp'
CLVALU(35) = ' '
OneSatObs = ''
CFAMI(10) = 'UA'
CFAMI(11) = 'UA'
CFAMI(12) = 'AI'
CFAMI(13) = 'AI'
CFAMI(14) = 'AI'
CFAMI(15) = 'SF'
CFAMI(16) = 'SF'
CFAMI(17) = 'TO'
CFAMI(18) = 'SW'
CFAMI(19) = 'SW'
CFAMI(20) = 'SW'
CFAMI(21) = 'SW'
CFAMI(22) = 'SW'
CFAMI(23) = 'SW'
CFAMI(24) = 'SW'
CFAMI(25) = 'GO'
CFAMI(26) = 'SC'
CFAMI(27) = 'PR'
CFAMI(28) = 'RO'
CFAMI(29) = 'HU'
CFAMI(30) = 'ST'
CFAMI(31) = 'MI'
CFAMI(32) = 'OZ'
CFAMI(33) = 'OZ'
CFAMI(34) = 'GP'
CFAMI(35) = ' '
c
INQUIRE(FILE=CLVALU(1),EXIST=isExist_L)
IF ( isExist_L )then
write(nulout,*) 'sufilnam:CLVALU(1),NULNAM ',CLVALU(1),NULNAM
IER=FNOM(NULNAM,clvalu(1),'FTN+SEQ+R/O',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'INML - File :', clvalu(1)
write(nulout,*) ' opened as unit file ',nulnam
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM:Problem opening namelist file!')
ENDIF
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM:No namelist file specified!')
ENDIF
C
CALL SUCT0(NULOUT)
c
INQUIRE(FILE=CLVALU(2),EXIST=isExist_L)
IF ( isExist_L )then
IER=FNOM(NULSTAT,CLVALU(2),'RND+OLD+R/O',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'IOBSST - File :', clvalu(2)
write(nulout,*) ' opened as unit file ',nulstat
ier = fstouv(nulstat,'RND+OLD')
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM:NO OBSERVATION STAT FILE!!')
ENDIF
ENDIF
C
C____ INITIALIZE TRIAL FIELD FILE NAME
C_____ Hardcoded the names of trial files
C
ntrials=0
jj=1
DO
WRITE(flnum,'(I2.2)') jj
trialfile='./trlm_'//flnum
INQUIRE(FILE=trialfile,EXIST=ltrial)
IF(ltrial) THEN
ntrials=ntrials+1
ier1=FNOM(ninmpg(ntrials),trialfile,'RND+OLD+R/O',0)
WRITE(nulout,*) 'ITRIAL - File :', trialfile
WRITE(nulout,*) ' opened as unit file ',ninmpg(ntrials)
ier1 = fSTOUV(ninmpg(ntrials),'RND+OLD')
ELSE IF ( (.not. ltrial) .and. ntrials >0 ) THEN
EXIT
ELSE IF ( (.not. ltrial) .and. ntrials == 0 ) THEN
CALL ABORT3D(NULOUT,'SUFILNAM:NO TRIAL FILE')
ENDIF
jj=jj+1
ENDDO
C
C____ INITIALIZE ANALYSYS FILE NAME
C
IF(myid == 0) THEN ! CLVALU(4) is output...
IER=FNOM(nulstd,CLVALU(4),'RND',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'OANAL - File :', clvalu(4)
write(nulout,*) ' opened as unit file ',nulstd
IER = FSTOUV(NULSTD,'RND')
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM:UNABLE TO OPEN ANAL FILE!!')
ENDIF
ENDIF
c
INQUIRE(FILE=CLVALU(5),EXIST=isExist_L)
IF ( isExist_L )then
IER=FNOM(nulbgst,CLVALU(5),'RND+OLD+R/O',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'IBGST - File :', clvalu(5)
write(nulout,*) ' opened as unit file ',nulbgst
ier = fstouv(nulbgst,'RND+OLD')
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM:NO BACKGROUND STAT FILE!!')
ENDIF
ENDIF
c==============================================================
IF(myid == 0) THEN
ier = fnom(nulinclr,clvalu(6),'RND',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'OINCLR - File :', clvalu(6)
write(nulout,*) ' opened as unit file ',nulinclr
ier = fstouv(nulinclr,'RND')
else
CALL ABORT3D(NULOUT,'SUFILNAM')
endif
ENDIF
c
IF(myid == 0) THEN
ier = fnom(nulinchr,clvalu(7),'RND',0)
IF ( IER .EQ. 0 ) THEN
write(nulout,*) 'OINCHR - File :', clvalu(7)
write(nulout,*) ' opened as unit file ',nulinchr
ier = fstouv(nulinchr,'RND')
ELSE
CALL ABORT3D(NULOUT,'SUFILNAM')
ENDIF
ENDIF
c
! Get CLVALU(8) through Environment Variables.
CALL get_environment_variable('ARMA_EXEC4DV',CLVALU(8),
+ chlength,istatus,.true.)
print*,'EXEC4D,CLVALU(8)= ',CLVALU(8)
if ( len_trim(clvalu(8)) .gt. 0 ) then
CEXC4DV=clvalu(8)
l4dvar=.true.
else
l4dvar=.false.
endif
WRITE(nulout,*)' l4dvar = ',l4dvar
C
C------ Preconditioning..
INQUIRE(FILE=CLVALU(9),EXIST=isExist_L)
if ( isExist_L ) then
CPCONF=clvalu(9)
lpcon=.true.
else
lpcon=.false.
endif
c
C-------Check Burp files....
CALL GET_ENVIRONMENT_VARIABLE('VAR3D_BGCK',OneSatObs,chlength,istatus,.true.)
print*,'OneSatObs = ',OneSatObs
print*,'NCONF LEN OF OneSatObs = ',nconf,len_trim(OneSatObs)
IF((NCONF == 101 .or. NCONF == 121).and. len_trim(OneSatObs) > 0 ) THEN
ii=0
NKOUNT=1
INQUIRE(FILE=OneSatObs,EXIST=isExist_L)
IF(isExist_L)THEN
IER=FNOM(II,OneSatObs,'RND+OLD',0)
IF(ier == 0) THEN
INBLKS = -1
INBLKS=NUMBLKS(II)
IF(INBLKS >0 )THEN
CBURP(1)=OneSatObs
CFAM(1)='SW'
ENDIF
ENDIF
IER = FCLOS(II)
DO jj=1,INFIL
IF(oneSatObs == CLVALU(jj) ) THEN
CFAM(1)=CFAMI(jj)
EXIT
ENDIF
ENDDO
ELSE
CALL ABORT3D(nulout,'SUFILNAM:file doesnot exist!')
ENDIF
ELSE
NKOUNT=0
DO JJ=10,INFIL
II=0
IF(CLVALU(JJ) /= '') THEN
INQUIRE(FILE=CLVALU(JJ),EXIST=isExist_L)
!!!IF((NCONF == 101 .or. NCONF == 121) .and. (CLVALU(JJ) == 'brptov'.or.CLVALU(JJ) == 'brpais'.or. CLVALU(JJ) == 'brpain')) isExist_L=.false.
IF(NCONF == 101 .and. (CLVALU(JJ) == 'brptov'.or.CLVALU(JJ) == 'brpais'.or. CLVALU(JJ) == 'brpain')) isExist_L=.false.
ELSE
EXIT
ENDIF
IF ( isExist_L )THEN
IER=FNOM(II,CLVALU(JJ),'RND+OLD',0)
WRITE(NULOUT,*)' Open File : ',CLVALU(JJ)
IF ( IER .EQ. 0 ) THEN
INBLKS= -1
INBLKS=NUMBLKS(II)
IF ( INBLKS .GT. 0 ) THEN
C=======================================
NKOUNT=NKOUNT+1
CBURP(NKOUNT)=CLVALU(JJ)
CFAM(NKOUNT)=CFAMI(JJ)
C=======================================
ENDIF
ENDIF
IER= FCLOS(II)
ENDIF
END DO
ENDIF
C
C Hard coded restart file name
crestart='wrmrestart'
INQUIRE(file=crestart,exist=lrestart)
C
WRITE(NULOUT,*) ' '
WRITE(NULOUT,*)' NUMBER OF BURP FILES IS :',NKOUNT
WRITE(NULOUT,*)'TYPE NAME '
WRITE(NULOUT,*)'---- ---- '
DO JJ=1,NKOUNT
WRITE(NULOUT,'(1X,A2,1X,A128)' )CFAM(JJ),CBURP(JJ)
END DO
RETURN
END