SUBROUTINE SUDIM(KULOUT) 1,3
#if defined (DOC)
*
***s/r SUDIM * - Setting up of the dimensions
* --------
*
*Author: Based on a subroutine written by
* Mats Hamrud and Philippe Courtier *ECMWF*
* P. Gauthier *ARMA/AES June 9, 1992
*Revision:
* . P. Gauthier *ARMA/AES May 25,1993: -Dimensions for specific humidity
* . and surface pressure
* . S. Pellerin *ARMA/AES Sept 97.
* - Control of the different model state of the 3Dvar
* through COMSTATE, COMSTATEC and COMSTNUM common
* blocks variables (comstate.cdk).
* . S. Pellerin *ARMA/SMC May 2000
* . Introduction of nconf 141
* . M. Buehner *ARMA/MSC April 2002
* . Read NAMSV and adjust NVADIM to include space for SVs
* . Y. Yang Nov. 2003
* . Changed RSIGTR and RPORTR to vectors to accommodate
* multiple species.
* . Switched order of "comdim.cdk" and "comstate.cdk"
* due to dependences
* . M. Tanguay *ARMN/MSC Jan. 2005
* . Introduction of minimizer N1CG1
* . M. Buehner *ARMA May 2008
* . Added namelist variables for vertical localization of
* correlations and using multiple latitude bands
* of correlations and new approach for PtoT and
* localized Tb correlations (NANALVAR=4)
*
* . Y. Nezlin ARQX March 2006 (in collaboration with Y.J. Rochon)
* - Added NPERTBG, LPERTOBS, and LmodelER
* (for use with code by M. Buehner)
* . M. Buehner *ARMA/MSC
* - Added RVLOC* localization lengths.
* . Y.J. Rochon *ARQX/EC
* - Addition of RVLOCTR
*
*---------------
* Purpose: initialize COMDIM and read the namelist NAMDIM
*
*Arguments:
* i: KULOUT (logical unit for optional printing i.e. debugging)
* o: comdim.cdk (COMDECK containing the dimensions of the model
*
#endif
C
use modstag, only: nj_s, njlath_s, level2_staggrid, lstagwinds
!
IMPLICIT NONE
#include "comdim.cdk"
#include "comlun.cdk"
#include "comct0.cdk"
#include "comcva.cdk"
#include "comsv.cdk"
INTEGER KULOUT, IAL1, IAL2, IERR, ILEN
INTEGER JJ
C
C
C* 1. SET DEFAULT VALUES AND MODIFY THEM.
C -----------------------------------
C
100 CONTINUE
C
C* 1.1 Default values
C --------------
110 CONTINUE
C
N1GC = 3
NVAMAJ = 6
NIMPRES = 5
NITERMAX = 400
RDF1FAC = 0.25d0
NITERJOB = -1
NSIMMAX = 500
NGRTEST = 0
NGRANGE = 15
NCNTVAR = 2
NEVALJ = 1
lxbar = .true.
ltlmend = .false.
LTSTSP = .FALSE.
LTSTCVA = .FALSE.
LNONSEP = .TRUE.
REPSG = 1e-3
LRSTART = .FALSE.
LSTAT = .TRUE.
RSIGGZ = 0.0
DO JJ = 1, NCMTMAX
RSIGTR(JJ) = 1.0
ENDDO
RSIGPS = 1.0
RSIGTG = 1.5
RSIGQ = 1.0
RNU2 = 0.0
RSIGUU = 2.92
RSIGTT = 0.0
NANALVAR = 3
RPORVO = 6000.E3
RPORDI = 6000.E3
RPORTT = 3000.E3
RPORQ = 3000.E3
RPORPS = 3000.E3
RPORTG = 500.E3
RPORGZ = 1200000.
DO JJ = 1, NCMTMAX
RPORTR(JJ) = 3000.E3
ENDDO
CIMP = 'G'
CFG = 'F'
CCOV = 'H'
CSCAL = 'P'
CFGERR = 'G'
CHUM = 'LQ'
EPSNEG = 1e-6
SELECT0 = 0
BFGSB = 2
IMODE3 = 0
NTUNESTATS = 0
NPERTBG = 0
LPERTOBS = .FALSE.
LmodelER = .FALSE.
C
NFLEVPTOT = -999
RSCALEPTOT = 1.0
LHBHT1 = .FALSE.
LUSE3DSTD = .FALSE.
NTRUNC3DSTD = 0
LCOPYPTOT = .FALSE.
CFLTUNEOBS= 'none'
CFLTUNEBG = 'none'
C
RVLOCBALT = 0.0
RVLOCPSI = 0.0
RVLOCCHI = 0.0
RVLOCUNBALT = 0.0
RVLOCLQ = 0.0
RVLOCPSITT = 0.0
C
DO JJ = 1, NCMTMAX
RVLOCTR(JJ) = 0.0
ENDDO
C
NLATMIN1 = 40
NLATMAX1 = 50
NLATMIN2 = 71
NLATMAX2 = 81
C
WRITE(UNIT=KULOUT,FMT='(//," Modification of the dimensions:"
S ," of the control variable",/,10x
S ,"- reading the namelist NAMCVA in SUDIM")')
C
CALL READNML('NAMCVA',IERR)
level2_staggrid = .false.
write(kulout,fmt='(4x,A,L3)')' LEVEL2_staggrid = ',level2_staggrid
C
NI=240
NIINC=240
NJ=120
NJINC=120
NFLEV=28
NISUR=2
NJSUR=2
NVGAUX=0
NTRUNCINC=108
NTRUNC=108
NVSAUX=0
nprecon=0
NLATBIN=1
C
120 CONTINUE
WRITE(UNIT=KULOUT,FMT='(//,'' MODIFICATION OF THE DIMENSIONS:''
S ,''- reading the namelist NAMDIM in SUDIM'')')
C
CALL READNML('NAMDIM',IERR)
C
C* . 1.3 Check the consistency between the number of spectral
C . and gridpoint fields
C . ----------------------------------------------------
C
IF(NFLEVPTOT.lt.0) NFLEVPTOT=NFLEV
WRITE(KULOUT,*) 'NFLEVPTOT=',NFLEVPTOT
130 CONTINUE
IF(NVGD.NE.NVSP)THEN
WRITE(NULOUT,FMT=9130)' NVGD',NVGD,' NVSP',NVSP
NVGD = NVSP
END IF
IF(NVG2D.NE.NVSP2D) THEN
WRITE(NULOUT,FMT=9130)' NVG2D',NVG2D,'NVSP2D',NVSP2D
NVG2D = NVSP2D
END IF
IF(NVGAUX.NE.NVSAUX) THEN
WRITE(NULOUT,FMT=9130)'NVGAUX',NVGAUX,'NVSAUX',NVSAUX
NVGAUX = NVSAUX
END IF
9130 FORMAT(4X,'-INCONSISTENCY IN THE NUMBER OF FIELDS: ',A6,'= ',I4
S ,4X,A6,'= ',I4,/,8X,'RESET TO THE SPECTRAL VALUES')
C
C* 2. Initialize the dimensions (dependent dimensions).
C
NI=NIINC
NJ=NJINC
NTRUNC=NTRUNCINC
C
200 CONTINUE
C
C* . 2.1 Collocation grid dimensions.
C . ---------------------------
C
210 CONTINUE
NJLATH = (NJ + 1)/2
nj_s = nj-1
njlath_s = nj/2
NJBEG = - NJSUR + 1
NJEND = NJ + NJSUR
IF(MOD(NJ,2).EQ.0) THEN
NJMAX = NJ+1
ELSE
NJMAX = NJ
END IF
C
NIBEG = 0
NIEND = NI + NISUR
C
WRITE(KULOUT,*)' DIMENSIONS IN GRID SPACE ------:'
WRITE(UNIT=KULOUT,FMT=9210)
S NJ ,NJLATH, NJSUR,NJBEG ,NJEND ,NI ,NISUR, NIBEG
S , NIEND,NFLEV
9210 FORMAT(4X,
S ' NJ =',I6,' NJLATH =',I6,
S ' NJSUR =',I6,' NJBEG =',I6,' NJEND =',I6,/,4X,
S ' NI =',I6,' NISUR =',I6,' NIBEG =',I6,
S ' NIEND =',I6,' NFLEV = ',I6)
write(kulout,fmt='(4x,A,i6,A,i6)')'NJ_S = ',nj_s,' NJLATH_S = ',njlath_s
IF(NLATBD.GT.NJLATH) THEN
NLATBD = NJLATH
WRITE(NULOUT,9211)NLATBD, NJLATH
END IF
9211 FORMAT(6X,'Width of latitudinal band is too wide. In SUDIM'
S ,' NLATBD is reset to NJLATH',/10X,'NLATBD = ',I3,4X
S ,'NJLATH = ',I3)
C
C* . 2.2 Spectral dimensions
C . -------------------
C
NLA = (NTRUNC + 1)*(NTRUNC +2)/2
NLARH = (NTRUNC+1)*(NTRUNC+1)
IF(MOD(NTRUNC+1,2).EQ.0) THEN
NTRUNCMX = NTRUNC + 1
ELSE
NTRUNCMX = NTRUNC
END IF
IF(MOD(NLA,2).EQ.0) THEN
NLADIM = NLA+1
ELSE
NLADIM = NLA
END IF
C
WRITE(KULOUT,*)' DIMENSIONS IN SPECTRAL SPACE ------:'
WRITE(UNIT=KULOUT,FMT=9220)NTRUNC, NTRUNCMX, NLA, NLADIM, NLARH
9220 FORMAT(/,' Triangular truncation of order '
S ,'NTRUNC =',I4,' NTRUNCMX: ',I4,' NLA:',I8,' NLADIM:',I8
S ,' NLARH:',I8)
C
C* . 2.3 Check for aliasing.
C . ------------------
C
220 CONTINUE
*
IAL1=3*NTRUNC - (2*NJ-1)
IF (IAL1 .GT. 0) THEN
WRITE(UNIT=KULOUT,
S FMT='('' ******* ALIASING FOR PRODUCTS OF FIELDS ''
S ,'' IN THE N-S DIRECTION ******** '')')
*
IAL1=2*NTRUNC - (2*NJ-1)
IF (IAL1 .GT. 0) THEN
WRITE(UNIT=KULOUT,
S FMT='('' ******* ALIASING FOR SPECTRAL TRANSFORMS ''
S ,'' IN THE N-S DIRECTION ******** '')')
ENDIF
ENDIF
*
*
IAL2=3*NTRUNC - (NI-1)
IF (IAL2 .GT. 0) THEN
WRITE(UNIT=KULOUT,
S FMT='('' ******* ALIASING FOR PRODUCTS OF FIELDS ''
S ,'' IN THE E-W DIRECTION ******** '')')
*
IAL2=2*NTRUNC - (NI-1)
IF (IAL2 .GT. 0) THEN
WRITE(UNIT=KULOUT,
S FMT='('' ******* ALIASING FOR SPECTRAL TRANSFORMS ''
S ,'' IN THE E-W DIRECTION ******** '')')
ENDIF
ENDIF
C
C* 3. Initialize the number of fields.
C -----------------------------------
300 CONTINUE
C
C* . 3.1 Total number of 2D fields in grid space
C . ---------------------------------------
C
310 CONTINUE
C
NKGDIM = (NVGD+ NVGAUX)* NFLEV + NVG2D
C
WRITE(UNIT=KULOUT,FMT=9310)
S NVGD,NVGAUX,NVG2D,NKGDIM
9310 FORMAT(/,5X,'Number of variables in grid',
S ' space',/,
S ' NVGD =',I6,' NVGAUX =',I6,
S ' NVG2D =',I6,' NKGDIM =',I6)
C
C
C* . 3.2 Total number of spectral fields
C . -------------------------------
C
320 CONTINUE
NKSDIM = (NVSP + NVSAUX)*NFLEV + NVSP2D
if(nconf.ne.300.and.nconf.ne.800.and.nconf.ne.801.and.nconf.ne.500.and.nanalvar.eq.4) then
NKSDIM2 = NKSDIM+NFLEV
else
NKSDIM2 = NKSDIM
endif
C
WRITE(UNIT=KULOUT,FMT='(/,5X,''Number of variables in SPECTRAL'',
S '' space'',/,
S '' NVSP ='',I6,'' NVSAUX ='',I6,
S '' NVSP2D ='',I6,'' NKSDIM ='',I6)')
S NVSP,NVSAUX,NVSP2D,NKSDIM
C
C* 4. Dimension of the control variable
C . ---------------------------------
C
400 CONTINUE
C
C Read NAMSV and adjust adjust NVADIM, if necessary, for incorporating SVs into B
C
CSVNORM='E'
NSV=0
NUMSEG=1
NSVMODE=0
IF(NINT(NCONF/100.0).EQ.6) CALL READNML('NAMSV',IERR)
ILEN = NSV
IF(NSVMODE.eq.1) THEN
NVADIM = ILEN
ELSEIF(NSVMODE.eq.2) THEN
NVADIM = NKSDIM*(2*NLA - NTRUNC -1) + ILEN
ELSE
NVADIM = NKSDIM*(2*NLA - NTRUNC -1)
ENDIF
cbue
cbue NVADIM=NVADIM+NFLEV*(2*NLA - NTRUNC -1)
C
NVADIM=NVADIM*NLATBIN
C
IF(N1GC.EQ.2) THEN
NMTRA = 3*NVADIM + NVAMAJ*(2*NVADIM + 1)
ELSE IF(N1GC.EQ.3)THEN
NMTRA = 4*NVADIM + NVAMAJ*(2*NVADIM + 1)
ELSE IF(N1GC.EQ.4)THEN
NMTRA = 1 + NVAMAJ*(2*NVADIM + 1)
NWORK = 5*NVADIM + NVAMAJ
ELSE
NMTRA = NVADIM*2
END IF
WRITE(KULOUT,9401)N1GC, NVAMAJ,NVADIM,NMTRA
9401 FORMAT(4X,'N1GC = ',I2,4X,'NVAMAJ = ',I3
S ,/5X,"NVADIM =",1x,I9,3X,"NMTRA =",1X,I9)
IF(N1GC.EQ.4) THEN
WRITE(KULOUT,9402)NWORK
9402 FORMAT(4X,'FOR N1CG1:',4X,'NWORK = ',I9)
ENDIF
C
RETURN
END