Ignore:
Timestamp:
Jun 15, 2015, 8:48:31 PM (9 years ago)
Author:
dcugnet
Message:

In dyn3d/:
etat0dyn_netcdf.F90: "startget_dyn3d" syntax slightly simplified.
dynredem.F90: Shortcut routines (put_var*, cre_var,
dynredem_write_*, dynredem_read_u)

modified to match dyn3dmem version and put in

module dyredem_mod.F90.
dynetat0.F90 -> *.f90: Few simplifications (no usage of NC_DOUBLE
needed => no precompilation)

Add tracers initialization in the isotope case

suppressed by accident.
dynredem_mod.F90: Created to mimic dyn3dmem equivalent.

In dyn3dmem/:
dynetat0_loc.F -> *.f90: Converted into fortran 90 to match the dyn3d
version.
dynredem_loc.F -> *.F90: Converted into fortran 90.
dynredem_mod.F90: Add some shortcut routines to match the dyn3d
version.

In phylmd/:
phyredem.F90: Bug fix: nsw instead of nsoilmx was used as
Tsoil second maximum index.

Bug fix: fevap instead of snow was saved for

"SNOW".
etat0phys_netcdf.F90: "filtreg_mod" module usage suppressed.

Local variable rugo computation removed (not

used).

In dynlonlat_phylonlat/:
grid_atob_m.F90 -> *.f90 DOUBLE PRECISION variables usage removed.

Precompilation o longer needed => .F90 extension.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3d/etat0dyn_netcdf.F90

    r2293 r2299  
    1212!  routine (to be called after restget):
    1313!    CALL startget_dyn3d(varname, lon_in,  lat_in, pls, workvar,&
    14 !                 champ, val_exp, lon_in2, lat_in2, ibar)
     14!                          champ, lon_in2, lat_in2, ibar)
    1515!
    1616!    *  Variables should have the following names in the NetCDF files:
    … …  
    8787  USE infotrac
    8888  USE filtreg_mod
    89 !#endif
    9089  IMPLICIT NONE
    9190!-------------------------------------------------------------------------------
    … …  
    120119!*******************************************************************************
    121120  CALL infotrac_init
    122   ALLOCATE(q3d(iip1,jjp1,llm,nqtot))
    123121  CALL inifilr()
    124122
    … …  
    154152! Update uvent, vvent, t3d and tpot
    155153!*******************************************************************************
    156   uvent(:,:,:) = 0.0 ; t3d (:,:,:) = 0.0
    157   vvent(:,:,:) = 0.0 ; tpot(:,:,:) = 0.0
    158   CALL startget_dyn3d('u'   ,rlonu,rlatu,pls,y ,uvent,0.0,rlonv,rlatv,ib)
    159   CALL startget_dyn3d('v'   ,rlonv,rlatv,pls(:,:jjm,:),y(:,:jjm,:),vvent,0.0,  &
     154  uvent(:,:,:) = 0.0 ; vvent(:,:,:) = 0.0 ; t3d (:,:,:) = 0.0
     155  CALL startget_dyn3d('u'   ,rlonu,rlatu,pls,y ,uvent,rlonv,rlatv,ib)
     156  CALL startget_dyn3d('v'   ,rlonv,rlatv,pls(:,:jjm,:),y(:,:jjm,:),vvent,      &
    160157 &                           rlonu,rlatu(:jjm),ib)
    161   CALL startget_dyn3d('t'   ,rlonv,rlatu,pls,y ,t3d ,0.0,rlonu,rlatv,ib)
    162   tpot=t3d
    163   CALL startget_dyn3d('tpot',rlonv,rlatu,pls,pk,tpot,0.0,rlonu,rlatv,ib)
     158  CALL startget_dyn3d('t'   ,rlonv,rlatu,pls,y ,t3d ,rlonu,rlatv,ib)
     159  tpot(:,:,:)=t3d(:,:,:)
     160  CALL startget_dyn3d('tpot',rlonv,rlatu,pls,pk,tpot,rlonu,rlatv,ib)
    164161
    165162  WRITE(lunout,*) 'T3D min,max:',MINVAL(t3d(:,:,:)),MAXVAL(t3d(:,:,:))
    … …  
    174171!  WRITE(lunout,*) 'QSAT :',qsat(10,20,:)
    175172  qd (:,:,:) = 0.0
    176   CALL startget_dyn3d('q',rlonv,rlatu,pls,qsat,qd,0.0,rlonu,rlatv,ib)
    177   q3d(:,:,:,:) = 0.0 ; q3d(:,:,:,1) = qd(:,:,:)
    178 
     173  CALL startget_dyn3d('q',rlonv,rlatu,pls,qsat,qd,rlonu,rlatv,ib)
     174  ALLOCATE(q3d(iip1,jjp1,llm,nqtot)); q3d(:,:,:,:)=0.0 ; q3d(:,:,:,1)=qd(:,:,:)
    179175  CALL flinclo(fid_dyn)
    180176
    181177#ifdef CPP_PHYS
     178#ifdef CPP_EARTH
    182179! Parameterization of ozone chemistry:
    183180!*******************************************************************************
    … …  
    190187    q3d(:,:,:,i)=q3d(:,:,:,i)*48./ 29.                  !--- Mole->mass fraction         
    191188  END IF
     189
    192190#endif
     191#endif
     192  q3d(iip1,:,:,:)=q3d(1,:,:,:)
    193193
    194194! Intermediate computation
    … …  
    204204    masse(:,jjp1,l)=xps
    205205  END DO
    206   q3d(iip1,:,:,:)=q3d(1,:,:,:)
    207206
    208207! Writing
    … …  
    234233
    235234!#endif
    236 !#endif of #ifdef CPP_EARTH
     235! of ifdef CPP_EARTH
    237236
    238237END SUBROUTINE etat0dyn_netcdf
    … …  
    244243!-------------------------------------------------------------------------------
    245244!
    246 SUBROUTINE startget_dyn3d(var,  lon_in,  lat_in,  pls,  workvar,&
    247                 champ, val_exp, lon_in2, lat_in2, ibar)
     245SUBROUTINE startget_dyn3d(var, lon_in,  lat_in,  pls,  workvar,&
     246                        champ, lon_in2, lat_in2, ibar)
    248247!-------------------------------------------------------------------------------
    249248  IMPLICIT NONE
    … …  
    253252!-------------------------------------------------------------------------------
    254253! Note: An input auxilliary field "workvar" has to be specified in two cases:
    255 !     * for "q":     the saturated humidity.
    256 !     * for "topot": the Exner function.
     254!     * for "q":    the saturated humidity.
     255!     * for "tpot": the Exner function.
    257256!===============================================================================
    258257! Arguments:
    … …  
    263262  REAL,             INTENT(IN)    :: workvar(:, :, :) ! dim (iml, jml, lml)
    264263  REAL,             INTENT(INOUT) :: champ  (:, :, :) ! dim (iml, jml, lml)
    265   REAL,             INTENT(IN)    :: val_exp
    266264  REAL,             INTENT(IN)    :: lon_in2(:)       ! dim (iml)
    267265  REAL,             INTENT(IN)    :: lat_in2(:)       ! dim (jml2)
    … …  
    274272  REAL               :: xppn, xpps
    275273!-------------------------------------------------------------------------------
    276   IF(MINVAL(champ)==MAXVAL(champ).AND.MINVAL(champ)==val_exp) THEN
    277     iml = assert_eq([SIZE(lon_in),SIZE(pls,1),SIZE(workvar,1),SIZE(champ,1),  &
    278      &               SIZE(lon_in2)],TRIM(modname)//" iml")
    279     jml = assert_eq( SIZE(lat_in),SIZE(pls,2),SIZE(workvar,2),SIZE(champ,2),  &
    280      &                              TRIM(modname)//" jml")
    281     lml = assert_eq(              SIZE(pls,3),SIZE(workvar,3),SIZE(champ,3),  &
    282      &                              TRIM(modname)//" lml")
    283     jml2 = SIZE(lat_in2)
    284 
    285   !--- CHECK IF THE FIELD IS KNOWN
    286     SELECT CASE(var)
    287       CASE('u');    vname='U'
    288       CASE('v');    vname='V'
    289       CASE('t');    vname='TEMP'
    290       CASE('q');    vname='R';    msg='humidity as the saturated humidity'
    291       CASE('tpot'); vname='TEMP'; msg='potential temperature as the Exner function'
    292       CASE DEFAULT;               msg='No rule to extract variable '//TRIM(var)
    293         CALL abort_gcm(modname,TRIM(msg)//' from any data set',1)
    294     END SELECT
    295 
    296   !--- CHECK IF SOMETHING IS MISSING
    297     IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
    298       msg='Could not compute '//TRIM(msg)//' is missing or constant.'
    299       CALL abort_gcm(modname,TRIM(msg),1)
    300     END IF
    301 
    302   !--- INTERPOLATE 3D FIELD IF NEEDED
    303     IF(var/='tpot') CALL start_inter_3d(TRIM(vname),lon_in,lat_in,lon_in2,    &
    304                                                     lat_in2,pls,champ,ibar)
    305 
    306   !--- COMPUTE THE REQUIRED FILED
    307     SELECT CASE(var)
    308       CASE('u'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
    309         champ(iml,:,:)=champ(1,:,:)                        !--- Eastward wind
    310 
    311       CASE('v'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
    312         champ(iml,:,:)=champ(1,:,:)                        !--- Northward wind
    313 
    314       CASE('tpot','q')
    315         IF(var=='tpot') THEN; champ=champ*cpp/workvar      !--- Temperature
    316         ELSE;                 champ=champ*.01*workvar      !--- Relat. humidity
    317           WHERE(champ<0.) champ=1.0E-10
    318         END IF
    319         DO il=1,lml
    320           xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
    321           xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
    322           champ(:,1  ,il) = xppn
    323           champ(:,jml,il) = xpps
    324         END DO
    325     END SELECT
     274  iml=assert_eq([SIZE(lon_in),SIZE(pls,1),SIZE(workvar,1),SIZE(champ,1),       &
     275     &                                    SIZE(lon_in2)], TRIM(modname)//" iml")
     276  jml=assert_eq( SIZE(lat_in),SIZE(pls,2),SIZE(workvar,2),SIZE(champ,2),       &
     277     &                                                    TRIM(modname)//" jml")
     278  lml=assert_eq(              SIZE(pls,3),SIZE(workvar,3),SIZE(champ,3),       &
     279     &                                                    TRIM(modname)//" lml")
     280  jml2=SIZE(lat_in2)
     281
     282!--- CHECK IF THE FIELD IS KNOWN
     283   SELECT CASE(var)
     284    CASE('u');    vname='U'
     285    CASE('v');    vname='V'
     286    CASE('t');    vname='TEMP'
     287    CASE('q');    vname='R';    msg='humidity as the saturated humidity'
     288    CASE('tpot'); msg='potential temperature as the Exner function'
     289    CASE DEFAULT; msg='No rule to extract variable '//TRIM(var)
     290      CALL abort_gcm(modname,TRIM(msg)//' from any data set',1)
     291  END SELECT
     292
     293!--- CHECK IF SOMETHING IS MISSING
     294  IF((var=='tpot'.OR.var=='q').AND.MINVAL(workvar)==MAXVAL(workvar)) THEN
     295    msg='Could not compute '//TRIM(msg)//' is missing or constant.'
     296    CALL abort_gcm(modname,TRIM(msg),1)
    326297  END IF
     298
     299!--- INTERPOLATE 3D FIELD IF NEEDED
     300  IF(var/='tpot') CALL start_inter_3d(TRIM(vname),lon_in,lat_in,lon_in2,      &
     301                                                  lat_in2,pls,champ,ibar)
     302
     303!--- COMPUTE THE REQUIRED FILED
     304  SELECT CASE(var)
     305    CASE('u'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cu(:,1:jml); END DO
     306      champ(iml,:,:)=champ(1,:,:)                   !--- Eastward wind
     307
     308    CASE('v'); DO il=1,lml; champ(:,:,il)=champ(:,:,il)*cv(:,1:jml); END DO
     309      champ(iml,:,:)=champ(1,:,:)                   !--- Northward wind
     310
     311    CASE('tpot','q')
     312      IF(var=='tpot') THEN; champ=champ*cpp/workvar !--- Potential temperature
     313      ELSE;                 champ=champ*.01*workvar !--- Relative humidity
     314        WHERE(champ<0.) champ=1.0E-10
     315      END IF
     316      DO il=1,lml
     317        xppn = SUM(aire(:,1  )*champ(:,1  ,il))/apoln
     318        xpps = SUM(aire(:,jml)*champ(:,jml,il))/apols
     319        champ(:,1  ,il) = xppn
     320        champ(:,jml,il) = xpps
     321      END DO
     322  END SELECT
    327323
    328324END SUBROUTINE startget_dyn3d
    … …  
    768764
    769765!#endif
    770 ! of #ifdef CPP_EARTH
     766! of ifdef CPP_EARTH
    771767
    772768END MODULE etat0dyn
Note: See TracChangeset for help on using the changeset viewer.