Changeset 2299


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.

Location:
LMDZ5/trunk/libf
Files:
1 added
5 edited
4 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3d/dynetat0.f90

    r2298 r2299  
    109109  CALL get_var2("cv"   ,cv)
    110110  CALL get_var2("aire" ,aire)
    111   CALL get_var2("phisinit",phis)
    112111  var="temps"
    113112  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
    … …  
    117116  END IF
    118117  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
     118  CALL get_var2("phisinit",phis)
    119119  CALL get_var3("ucov",ucov)
    120120  CALL get_var3("vcov",vcov)
    … …  
    126126  DO iq=1,nqtot
    127127    var=tname(iq)
    128     IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
    129       WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
    130       WRITE(lunout,*)"         It is hence initialized to zero"
    131       q(:,:,:,iq)=0.
    132     ELSE
    133       CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var)
     128    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
     129      CALL err(NF90_GET_VAR(fID,vID,q(:,:,:,iq)),"get",var); CYCLE
     130    END IF
     131    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
     132    WRITE(lunout,*)"         It is hence initialized to zero"
     133    q(:,:,:,iq)=0.
     134   !--- CRisi: for isotops, theoretical initialization using very simplified
     135   !           Rayleigh distillation las.
     136    IF(ok_isotopes.AND.iso_num(iq)>0) THEN
     137      IF(zone_num(iq)==0) q(:,:,:,iq)=q(:,:,:,iqpere(iq))*tnat(iso_num(iq))    &
     138     &             *(q(:,:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
     139      IF(zone_num(iq)==1) q(:,:,:,iq)=q(:,:,:,iqiso(iso_indnum(iq),phase_num(iq)))
    134140    END IF
    135141  END DO
    … …  
    158164SUBROUTINE get_var1(var,v)
    159165  CHARACTER(LEN=*), INTENT(IN)  :: var
    160 #ifdef NC_DOUBLE
    161   DOUBLE PRECISION, INTENT(OUT) :: v(:)
    162 #else
    163166  REAL,             INTENT(OUT) :: v(:)
    164 #endif
    165167  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
    166168  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
    … …  
    170172SUBROUTINE get_var2(var,v)
    171173  CHARACTER(LEN=*), INTENT(IN)  :: var
    172 #ifdef NC_DOUBLE
    173   DOUBLE PRECISION, INTENT(OUT) :: v(:,:)
    174 #else
    175174  REAL,             INTENT(OUT) :: v(:,:)
    176 #endif
    177175  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
    178176  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)
    … …  
    182180SUBROUTINE get_var3(var,v)
    183181  CHARACTER(LEN=*), INTENT(IN)  :: var
    184 #ifdef NC_DOUBLE
    185   DOUBLE PRECISION, INTENT(OUT) :: v(:,:,:)
    186 #else
    187182  REAL,             INTENT(OUT) :: v(:,:,:)
    188 #endif
    189183  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
    190184  CALL err(NF90_GET_VAR(fID,vID,v),"get",var)

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

    r2293 r2299  
    88#endif
    99  USE infotrac
    10   USE netcdf, ONLY:   NF90_CREATE, NF90_DEF_DIM, NF90_REDEF,  NF90_INQ_VARID, &
    11       NF90_CLOBBER,   NF90_CLOSE,  NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_ATT,   &
    12       NF90_UNLIMITED, NF90_GLOBAL, NF90_FLOAT,   NF90_DOUBLE
    13   USE netcdf95, ONLY: NF95_PUT_VAR
     10  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
     11                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
     12  USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, err, modname, fil
    1413  IMPLICIT NONE
    1514  include "dimensions.h"
    … …  
    2120  include "ener.h"
    2221  include "logic.h"
    23   include "netcdf.inc"
    2422  include "description.h"
    2523  include "serre.h"
    … …  
    3533  INTEGER, PARAMETER :: length=100
    3634  REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
    37   CHARACTER(LEN=20) :: modname
    3835!   For NetCDF:
    3936  CHARACTER(LEN=30) :: unites
    … …  
    4239  INTEGER :: sID, sigID, nID, vID, timID
    4340  INTEGER :: yyears0, jjour0, mmois0
    44   REAL :: zan0, zjulian, hours
    45 !===============================================================================
    46   modname='dynredem0'
     41  REAL    :: zan0, zjulian, hours
     42!===============================================================================
     43  modname='dynredem0'; fil=fichnom
    4744#ifdef CPP_IOIPSL
    4845  CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
    … …  
    10299! start_time: start_time of simulation (not necessarily 0.)
    103100  tab_cntrl(32) = start_time
    104 !.........................................................
    105101
    106102!--- File creation
    … …  
    121117
    122118!--- Define and save invariant fields
    123   CALL put_var1("controle","Parametres de controle" ,[indexID],tab_cntrl)
    124   CALL put_var1("rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
    125   CALL put_var1("rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
    126   CALL put_var1("rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
    127   CALL put_var1("rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
    128   CALL put_var1("nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
    129   CALL put_var1("nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
    130   CALL put_var1("ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
    131   CALL put_var1("bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
    132   CALL put_var1("presnivs",""                                ,[sID]  ,presnivs)
     119  CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
     120  CALL put_var1(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
     121  CALL put_var1(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
     122  CALL put_var1(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
     123  CALL put_var1(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
     124  CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
     125  CALL put_var1(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
     126  CALL put_var1(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
     127  CALL put_var1(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
     128  CALL put_var1(nid,"presnivs",""                                ,[sID]  ,presnivs)
    133129! covariant <-> contravariant <-> natural conversion coefficients
    134   CALL put_var2("cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
    135   CALL put_var2("cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
    136   CALL put_var2("aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
    137   CALL put_var2("phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
     130  CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
     131  CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
     132  CALL put_var2(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
     133  CALL put_var2(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis)
    138134
    139135!--- Define fields saved later
    140136  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
    141137               yyears0,mmois0,jjour0
    142   CALL put_var0("temps","Temps de simulation",[timID],unites)
    143   CALL put_var0("ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
    144   CALL put_var0("vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
    145   CALL put_var0("teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
     138  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
     139  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
     140  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
     141  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
    146142  DO iq=1,nqtot
    147     CALL put_var0(tname(iq),ttext(iq) ,[rlonvID,rlatuID,sID,timID])
     143    CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
    148144  END DO
    149   CALL put_var0("masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
    150   CALL put_var0("ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
    151   CALL err(NF90_ENDDEF(nid))
     145  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
     146  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
    152147  CALL err(NF90_CLOSE (nid))
    153148
    … …  
    155150  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
    156151
    157 
    158 CONTAINS
    159 
    160 
    161 SUBROUTINE put_var0(var,title,did,units)
    162   CHARACTER(LEN=*),           INTENT(IN) :: var, title
    163   INTEGER,                    INTENT(IN) :: did(:)
    164   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    165 #ifdef NC_DOUBLE
    166   CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
    167 #else
    168   CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
    169 #endif
    170   IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
    171   IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
    172 END SUBROUTINE put_var0
    173 
    174 
    175 SUBROUTINE put_var1(var,title,did,v,units)
    176   CHARACTER(LEN=*),           INTENT(IN) :: var, title
    177   INTEGER,                    INTENT(IN) :: did(1)
    178 #ifdef NC_DOUBLE
    179   DOUBLE PRECISION,           INTENT(IN) :: v(:)
    180 #else
    181   REAL,                       INTENT(IN) :: v(:)
    182 #endif
    183   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    184 #ifdef NC_DOUBLE
    185   CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
    186 #else
    187   CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
    188 #endif
    189   IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
    190   IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
    191   CALL err(NF90_ENDDEF(nid))
    192   CALL NF95_PUT_VAR(nid,vID,v)
    193   CALL err(NF90_REDEF(nid))
    194 END SUBROUTINE put_var1
    195 
    196 
    197 SUBROUTINE put_var2(var,title,did,v,units)
    198   CHARACTER(LEN=*),           INTENT(IN) :: var, title
    199   INTEGER,                    INTENT(IN) :: did(2)
    200 #ifdef NC_DOUBLE
    201   DOUBLE PRECISION,           INTENT(IN) :: v(:,:)
    202 #else
    203   REAL,                       INTENT(IN) :: v(:,:)
    204 #endif
    205   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    206 #ifdef NC_DOUBLE
    207   CALL err(NF90_DEF_VAR(nid,var,NF90_DOUBLE,did,vID),var)
    208 #else
    209   CALL err(NF90_DEF_VAR(nid,var,NF90_FLOAT,did,vID),var)
    210 #endif
    211   IF(title/="")      CALL err(NF90_PUT_ATT(nid,vID,"title",title),var)
    212   IF(PRESENT(units)) CALL err(NF90_PUT_ATT(nid,vID,"units",units),var)
    213   CALL err(NF90_ENDDEF(nid))
    214   CALL NF95_PUT_VAR(nid,vID,v)
    215   CALL err(NF90_REDEF(nid))
    216 
    217 END SUBROUTINE put_var2
    218 
    219 
    220 SUBROUTINE err(ierr,var)
    221   USE netcdf, ONLY: NF90_STRERROR, NF90_NOERR
    222   IMPLICIT NONE
    223   INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
    224   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: var    !--- VARIABLE NAME
    225   CHARACTER(LEN=256) :: file, msg
    226   IF(ierr==NF90_NoERR) RETURN
    227   msg='Error in "'//TRIM(modname)//'" for file "'//TRIM(fichnom)//'"'
    228   IF(PRESENT(var)) msg=TRIM(msg)//'" and variable "'//TRIM(var)//'"'
    229   WRITE(lunout,*)TRIM(msg)//': '//NF90_STRERROR(ierr)
    230 
    231 END SUBROUTINE err
    232 
    233152END SUBROUTINE dynredem0
    234153!
    … …  
    245164  USE infotrac
    246165  USE control_mod
    247   USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, NF90_NoErr,    &
    248                       NF90_CLOSE, NF90_WRITE,   NF90_GET_VAR
    249   USE netcdf95, ONLY: NF95_PUT_VAR
    250   USE assert_eq_m, ONLY: assert_eq
     166  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
     167                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
     168  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
     169                          err, modname, fil, msg
    251170  IMPLICIT NONE
    252 #include "dimensions.h"
    253 #include "paramet.h"
    254 #include "description.h"
    255 #include "comvert.h"
    256 #include "comgeom.h"
    257 #include "temps.h"
    258 #include "iniprint.h"
     171  include "dimensions.h"
     172  include "paramet.h"
     173  include "description.h"
     174  include "comvert.h"
     175  include "comgeom.h"
     176  include "temps.h"
     177  include "iniprint.h"
    259178!===============================================================================
    260179! Arguments:
    261   CHARACTER(LEN=*), INTENT(IN) :: fichnom           !-- FILE NAME
    262   REAL, INTENT(IN) ::  time                         !-- TIME
    263   REAL, INTENT(IN) ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
    264   REAL, INTENT(IN) ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
    265   REAL, INTENT(IN) ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
    266   REAL, INTENT(IN) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
    267   REAL, INTENT(IN) :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
    268   REAL, INTENT(IN) ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
     180  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
     181  REAL, INTENT(IN)    ::  time                         !-- TIME
     182  REAL, INTENT(IN)    ::  vcov(iip1,jjm, llm)          !-- V COVARIANT WIND
     183  REAL, INTENT(IN)    ::  ucov(iip1,jjp1,llm)          !-- U COVARIANT WIND
     184  REAL, INTENT(IN)    ::  teta(iip1,jjp1,llm)          !-- POTENTIAL TEMPERATURE
     185  REAL, INTENT(INOUT) ::     q(iip1,jjp1,llm,nqtot)    !-- TRACERS
     186  REAL, INTENT(IN)    :: masse(iip1,jjp1,llm)          !-- MASS PER CELL
     187  REAL, INTENT(IN)    ::    ps(iip1,jjp1)              !-- GROUND PRESSURE
    269188!===============================================================================
    270189! Local variables:
    271   INTEGER :: l, iq, nid, vID, nid_trac, vID_trac
     190  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
    272191  INTEGER, SAVE :: nb=0
    273192  INTEGER, PARAMETER :: length=100
    274 #ifdef NC_DOUBLE
    275   DOUBLE PRECISION   :: trac_tmp(ip1jmp1,llm)
    276 #else
    277   REAL               :: trac_tmp(ip1jmp1,llm)
    278 #endif
    279193  REAL               :: tab_cntrl(length) ! tableau des parametres du run
    280   CHARACTER(LEN=256) :: modname, var, fil
    281   LOGICAL            :: exist_file
    282 !===============================================================================
    283   modname='dynredem1'
    284   fil=fichnom
     194  CHARACTER(LEN=256) :: var, dum
     195  LOGICAL            :: lread_inca
     196!===============================================================================
     197
     198  modname='dynredem1'; fil=fichnom
    285199  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
    286200
    287201!--- Write/extend time coordinate
    288202  nb = nb + 1
    289   CALL sav_var1("temps",[time],nb)
     203  var="temps"
     204  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
     205  CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var)
    290206  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
    291207
    292208!--- Rewrite control table (itaufin undefined in dynredem0)
    293209  var="controle"
    294   CALL get_var1(var,tab_cntrl); tab_cntrl(31)=DBLE(itau_dyn + itaufin)
    295210  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    296   CALL NF95_PUT_VAR(nid,vID,tab_cntrl)
     211  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
     212  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
     213  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
     214  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
    297215
    298216!--- Save fields
    299   CALL sav_var3("ucov",ucov)
    300   CALL sav_var3("vcov",vcov)
    301   CALL sav_var3("teta",teta)
    302   CALL sav_var3("masse",masse)
    303   CALL sav_var2("ps"   ,ps)
     217  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm)
     218  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm)
     219  CALL dynredem_write_u(nid,"teta" ,teta ,llm)
     220  CALL dynredem_write_u(nid,"masse",masse,llm)
     221  CALL dynredem_write_u(nid,"ps"   ,ps   ,1)
    304222
    305223!--- Tracers in file "start_trac.nc" (added by Anne)
    306   IF (type_trac == 'inca') THEN
    307     fil="start_trac.nc"; INQUIRE(FILE=fil,EXIST=exist_file)
    308     IF(.NOT.exist_file) CALL war(-1,"open",fil)
    309   END IF
    310   DO iq=1,nqtot; var=tname(iq)
    311 
    312   !--- Usual case
    313     IF(type_trac/='inca') THEN
    314       CALL sav_var3(var,q(:,:,:,iq)); CYCLE
     224  lread_inca=.FALSE.; fil="start_trac.nc"
     225  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     226  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
     227
     228!--- Save tracers
     229  DO iq=1,nqtot; var=tname(iq); ierr=-1
     230    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
     231      fil="start_trac.nc"
     232      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
     233      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
     234      WRITE(lunout,*)msg(dum,var)
     235
     236
     237      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
    315238    END IF
    316 
    317   !--- Special case for INCA tracer read from "start_trac.nc"
    318     IF(NF90_INQ_VARID(nid_trac,var,vID_trac)/=NF90_NoErr) THEN
    319       CALL war(-1,"inq",var,fil)
    320       CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var,fil)
    321       CALL NF95_PUT_VAR(nid,vID,q(:,:,:,iq))
    322     ELSE
    323       WRITE(lunout,*)TRIM(modname)//": <"//TRIM(var)//"> found in "//fil
    324       CALL err(NF90_GET_VAR(nid_trac,vID_trac,trac_tmp),"get",var,fil)
    325     END IF
    326     CALL sav_var3(var,RESHAPE(trac_tmp,SHAPE=[iip1,jjp1,llm]))
     239    fil=fichnom
     240    CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm)
    327241  END DO
    328   CALL err(NF90_CLOSE(nid),"close",fichnom)
    329 
    330 
    331 CONTAINS
    332 
    333 
    334 SUBROUTINE get_var1(var,v)
    335   CHARACTER(LEN=*), INTENT(IN) :: var
    336   REAL,             INTENT(OUT) :: v(:)
    337   CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    338   CALL err(NF90_GET_VAR(nid,vID,v),"get",var)
    339 END SUBROUTINE get_var1
    340 
    341 
    342 SUBROUTINE sav_var1(var,v,start)
    343   CHARACTER(LEN=*),  INTENT(IN) :: var
    344 #ifdef NC_DOUBLE
    345   DOUBLE PRECISION,  INTENT(IN) :: v(:)
    346 #else
    347   REAL,              INTENT(IN) :: v(:)
    348 #endif
    349   INTEGER, OPTIONAL, INTENT(IN) :: start
    350   CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    351   IF(PRESENT(start)) THEN
    352     CALL NF95_PUT_VAR(nid,vID,v,start=[start])
    353   ELSE
    354     CALL NF95_PUT_VAR(nid,vID,v)
    355   END IF
    356 END SUBROUTINE sav_var1
    357 
    358 
    359 SUBROUTINE sav_var2(var,v)
    360   CHARACTER(LEN=*), INTENT(IN) :: var
    361 #ifdef NC_DOUBLE
    362   DOUBLE PRECISION, INTENT(IN) :: v(:,:)
    363 #else
    364   REAL,             INTENT(IN) :: v(:,:)
    365 #endif
    366   CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    367   CALL NF95_PUT_VAR(nid,vID,v)
    368 END SUBROUTINE sav_var2
    369 
    370 
    371 SUBROUTINE sav_var3(var,v)
    372   CHARACTER(LEN=*), INTENT(IN) :: var
    373 #ifdef NC_DOUBLE
    374   DOUBLE PRECISION, INTENT(IN) :: v(:,:,:)
    375 #else
    376   REAL,             INTENT(IN) :: v(:,:,:)
    377 #endif
    378 
    379 print*,'var='//TRIM(var)
    380 print*,SHAPE(v)
    381   CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
    382   CALL NF95_PUT_VAR(nid,vID,v)
    383 END SUBROUTINE sav_var3
    384 
    385 
    386 FUNCTION msg(typ,nam,fil)
    387   IMPLICIT NONE
    388   CHARACTER(LEN=256)           :: msg    !--- STANDARDIZED MESSAGE
    389   CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
    390   CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD NAME
    391   CHARACTER(LEN=*), INTENT(IN) :: fil    !--- FILE  NAME
    392   SELECT CASE(typ)
    393     CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
    394     CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
    395     CASE('open');  msg="Opening failed for <"//TRIM(nam)//">"
    396     CASE('close'); msg="Closing failed for <"//TRIM(nam)//">"
    397   END SELECT
    398   msg=TRIM(modname)//": "//TRIM(msg)
    399   IF(typ=="inq".AND.fil/="") msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
    400 
    401 END FUNCTION msg
    402 
    403 
    404 SUBROUTINE err(ierr,typ,nam,fil)
    405   IMPLICIT NONE
    406   INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
    407   CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
    408   CHARACTER(LEN=*),           INTENT(IN) :: nam    !--- FIELD NAME
    409   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fil    !--- FILE  NAME
    410   CHARACTER(LEN=256) :: file
    411   IF(ierr==NF90_NoERR) RETURN
    412   file=""; IF(PRESENT(fil)) file=fil
    413   CALL ABORT_gcm(modname,msg(typ,nam,file),ierr)
    414 END SUBROUTINE err
    415 
    416 
    417 SUBROUTINE war(ierr,typ,nam,fil)
    418   IMPLICIT NONE
    419   INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
    420   CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
    421   CHARACTER(LEN=*),           INTENT(IN) :: nam    !--- FIELD NAME
    422   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fil    !--- FILE  NAME
    423   CHARACTER(LEN=256) :: file
    424   IF(ierr==NF90_NoERR) RETURN
    425   file=""; IF(PRESENT(fil)) file=fil
    426   WRITE(lunout,*)msg(typ,nam,file)
    427 END SUBROUTINE war
    428 
     242  CALL err(NF90_CLOSE(nid),"close")
     243  fil="start_trac.nc"
     244  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
    429245
    430246END SUBROUTINE dynredem1

  • 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

  • LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.f90

    r2298 r2299  
     1SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,teta,q,masse,ps,phis,time)
    12!
    2 ! $Id$
     3!-------------------------------------------------------------------------------
     4! Authors: P. Le Van , L.Fairhead
     5!-------------------------------------------------------------------------------
     6! Purpose: Initial state reading.
     7!-------------------------------------------------------------------------------
     8  USE parallel_lmdz
     9  USE infotrac
     10  USE netcdf, ONLY: NF90_OPEN,  NF90_INQUIRE_DIMENSION, NF90_INQ_VARID,        &
     11      NF90_NOWRITE, NF90_CLOSE, NF90_INQUIRE_VARIABLE,  NF90_GET_VAR, NF90_NoErr
     12  USE control_mod, ONLY: planet_type
     13  USE assert_eq_m, ONLY: assert_eq
     14  IMPLICIT NONE
     15  include "dimensions.h"
     16  include "paramet.h"
     17  include "temps.h"
     18  include "comconst.h"
     19  include "comvert.h"
     20  include "comgeom.h"
     21  include "ener.h"
     22  include "description.h"
     23  include "serre.h"
     24  include "logic.h"
     25  include "iniprint.h"
     26!===============================================================================
     27! Arguments:
     28  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
     29  REAL, INTENT(OUT) ::  vcov(ijb_v:ije_v,llm)      !--- V COVARIANT WIND
     30  REAL, INTENT(OUT) ::  ucov(ijb_u:ije_u,llm)      !--- U COVARIANT WIND
     31  REAL, INTENT(OUT) ::  teta(ijb_u:ije_u,llm)      !--- POTENTIAL TEMP.
     32  REAL, INTENT(OUT) ::     q(ijb_u:ije_u,llm,nqtot)!--- TRACERS
     33  REAL, INTENT(OUT) :: masse(ijb_u:ije_u,llm)      !--- MASS PER CELL
     34  REAL, INTENT(OUT) ::    ps(ijb_u:ije_u)          !--- GROUND PRESSURE
     35  REAL, INTENT(OUT) ::  phis(ijb_u:ije_u)          !--- GEOPOTENTIAL
     36!===============================================================================
     37! Local variables:
     38  CHARACTER(LEN=256) :: msg, var, modname
     39  INTEGER, PARAMETER :: length=100
     40  INTEGER :: iq, fID, vID, idecal, ierr
     41  REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
     42  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
     43  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
     44  REAL,             ALLOCATABLE :: teta_glo(:,:)
     45!-------------------------------------------------------------------------------
     46  modname="dynetat0_loc"
     47
     48!--- Initial state file opening
     49  var=fichnom
     50  CALL err(NF90_OPEN(var,NF90_NOWRITE,fID),"open",var)
     51  CALL get_var1("controle",tab_cntrl)
     52
     53!!! AS: idecal is a hack to be able to read planeto starts...
     54!!!     .... while keeping everything OK for LMDZ EARTH
     55  IF(planet_type=="generic") THEN
     56    WRITE(lunout,*)'NOTE NOTE NOTE : Planeto-like start files'
     57    idecal = 4
     58    annee_ref  = 2000
     59  ELSE
     60    WRITE(lunout,*)'NOTE NOTE NOTE : Earth-like start files'
     61    idecal = 5
     62    annee_ref  = tab_cntrl(5)
     63  END IF
     64  im         = tab_cntrl(1)
     65  jm         = tab_cntrl(2)
     66  lllm       = tab_cntrl(3)
     67  day_ref    = tab_cntrl(4)
     68  rad        = tab_cntrl(idecal+1)
     69  omeg       = tab_cntrl(idecal+2)
     70  g          = tab_cntrl(idecal+3)
     71  cpp        = tab_cntrl(idecal+4)
     72  kappa      = tab_cntrl(idecal+5)
     73  daysec     = tab_cntrl(idecal+6)
     74  dtvr       = tab_cntrl(idecal+7)
     75  etot0      = tab_cntrl(idecal+8)
     76  ptot0      = tab_cntrl(idecal+9)
     77  ztot0      = tab_cntrl(idecal+10)
     78  stot0      = tab_cntrl(idecal+11)
     79  ang0       = tab_cntrl(idecal+12)
     80  pa         = tab_cntrl(idecal+13)
     81  preff      = tab_cntrl(idecal+14)
    382!
    4       SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
    5      .                    teta,q,masse,ps,phis,time)
    6       USE infotrac
    7       use control_mod, only : planet_type
    8       USE parallel_lmdz
    9       IMPLICIT NONE
    10 
    11 c=======================================================================
    12 c
    13 c   Auteur:  P. Le Van / L.Fairhead
    14 c   -------
    15 c
    16 c   objet:
    17 c   ------
    18 c
    19 c   Lecture de l'etat initial
    20 c
    21 c=======================================================================
    22 c-----------------------------------------------------------------------
    23 c   Declarations:
    24 c   -------------
    25 
    26 #include "dimensions.h"
    27 #include "paramet.h"
    28 #include "temps.h"
    29 #include "comconst.h"
    30 #include "comvert.h"
    31 #include "comgeom.h"
    32 #include "ener.h"
    33 #include "netcdf.inc"
    34 #include "description.h"
    35 #include "serre.h"
    36 #include "logic.h"
    37 #include "iniprint.h"
    38 
    39 c   Arguments:
    40 c   ----------
    41 
    42       CHARACTER*(*) fichnom
    43       REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    44       REAL teta(ijb_u:ije_u,llm)
    45       REAL q(ijb_u:ije_u,llm,nqtot),masse(ijb_u:ije_u,llm)
    46       REAL ps(ijb_u:ije_u),phis(ijb_u:ije_u)
    47 
    48       REAL time
    49 
    50 c   Variables
    51 c
    52       INTEGER length,iq
    53       PARAMETER (length = 100)
    54       REAL tab_cntrl(length) ! tableau des parametres du run
    55       INTEGER ierr, nid, nvarid
    56       REAL,ALLOCATABLE :: vcov_glo(:,:),ucov_glo(:,:),teta_glo(:,:)
    57       REAL,ALLOCATABLE :: q_glo(:,:),masse_glo(:,:),ps_glo(:)
    58       REAL,ALLOCATABLE :: phis_glo(:)
    59 
    60       INTEGER idecal
    61 
    62 c-----------------------------------------------------------------------
    63 c  Ouverture NetCDF du fichier etat initial
    64 
    65       ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
    66       IF (ierr.NE.NF_NOERR) THEN
    67         write(lunout,*)
    68      &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
    69         write(lunout,*)' ierr = ', ierr
    70         CALL ABORT_GCM("DYNETAT0", "", 1)
    71       ENDIF
    72 
    73 c
    74       ierr = NF_INQ_VARID (nid, "controle", nvarid)
    75       IF (ierr .NE. NF_NOERR) THEN
    76          write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
    77          CALL abort_gcm("dynetat0", "", 1)
    78       ENDIF
    79 #ifdef NC_DOUBLE
    80       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
    81 #else
    82       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
    83 #endif
    84       IF (ierr .NE. NF_NOERR) THEN
    85          write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
    86          CALL abort_gcm("dynetat0", "", 1)
    87       ENDIF
    88 
    89       !!! AS: idecal is a hack to be able to read planeto starts...
    90       !!!     .... while keeping everything OK for LMDZ EARTH
    91       if (planet_type.eq."generic") then
    92           print*,'NOTE NOTE NOTE : Planeto-like start files'
    93           idecal = 4
    94           annee_ref  = 2000
    95       else
    96           print*,'NOTE NOTE NOTE : Earth-like start files'
    97           idecal = 5
    98           annee_ref  = tab_cntrl(5)
    99       endif
    100 
    101 
    102       im         = tab_cntrl(1)
    103       jm         = tab_cntrl(2)
    104       lllm       = tab_cntrl(3)
    105       day_ref    = tab_cntrl(4)
    106       rad        = tab_cntrl(idecal+1)
    107       omeg       = tab_cntrl(idecal+2)
    108       g          = tab_cntrl(idecal+3)
    109       cpp        = tab_cntrl(idecal+4)
    110       kappa      = tab_cntrl(idecal+5)
    111       daysec     = tab_cntrl(idecal+6)
    112       dtvr       = tab_cntrl(idecal+7)
    113       etot0      = tab_cntrl(idecal+8)
    114       ptot0      = tab_cntrl(idecal+9)
    115       ztot0      = tab_cntrl(idecal+10)
    116       stot0      = tab_cntrl(idecal+11)
    117       ang0       = tab_cntrl(idecal+12)
    118       pa         = tab_cntrl(idecal+13)
    119       preff      = tab_cntrl(idecal+14)
    120 c
    121       clon       = tab_cntrl(idecal+15)
    122       clat       = tab_cntrl(idecal+16)
    123       grossismx  = tab_cntrl(idecal+17)
    124       grossismy  = tab_cntrl(idecal+18)
    125 c
    126       IF ( tab_cntrl(idecal+19).EQ.1. )  THEN
    127         fxyhypb  = . TRUE .
    128 c        dzoomx   = tab_cntrl(25)
    129 c        dzoomy   = tab_cntrl(26)
    130 c        taux     = tab_cntrl(28)
    131 c        tauy     = tab_cntrl(29)
    132       ELSE
    133         fxyhypb = . FALSE .
    134         ysinus  = . FALSE .
    135         IF( tab_cntrl(idecal+22).EQ.1. ) ysinus = . TRUE.
    136       ENDIF
    137 
    138       day_ini = tab_cntrl(30)
    139       itau_dyn = tab_cntrl(31)
    140 c   .................................................................
    141 c
    142 c
    143       write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
    144      &               rad,omeg,g,cpp,kappa
    145 
    146       IF(   im.ne.iim           )  THEN
    147           PRINT 1,im,iim
    148           STOP
    149       ELSE  IF( jm.ne.jjm       )  THEN
    150           PRINT 2,jm,jjm
    151           STOP
    152       ELSE  IF( lllm.ne.llm     )  THEN
    153           PRINT 3,lllm,llm
    154           STOP
    155       ENDIF
    156 
    157       ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
    158       IF (ierr .NE. NF_NOERR) THEN
    159          write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
    160          CALL abort_gcm("dynetat0", "", 1)
    161       ENDIF
    162 #ifdef NC_DOUBLE
    163       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonu)
    164 #else
    165       ierr = NF_GET_VAR_REAL(nid, nvarid, rlonu)
    166 #endif
    167       IF (ierr .NE. NF_NOERR) THEN
    168          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
    169          CALL abort_gcm("dynetat0", "", 1)
    170       ENDIF
    171 
    172       ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
    173       IF (ierr .NE. NF_NOERR) THEN
    174          write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
    175          CALL abort_gcm("dynetat0", "", 1)
    176       ENDIF
    177 #ifdef NC_DOUBLE
    178       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatu)
    179 #else
    180       ierr = NF_GET_VAR_REAL(nid, nvarid, rlatu)
    181 #endif
    182       IF (ierr .NE. NF_NOERR) THEN
    183          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
    184          CALL abort_gcm("dynetat0", "", 1)
    185       ENDIF
    186 
    187       ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
    188       IF (ierr .NE. NF_NOERR) THEN
    189          write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
    190          CALL abort_gcm("dynetat0", "", 1)
    191       ENDIF
    192 #ifdef NC_DOUBLE
    193       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlonv)
    194 #else
    195       ierr = NF_GET_VAR_REAL(nid, nvarid, rlonv)
    196 #endif
    197       IF (ierr .NE. NF_NOERR) THEN
    198          write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
    199          CALL abort_gcm("dynetat0", "", 1)
    200       ENDIF
    201 
    202       ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
    203       IF (ierr .NE. NF_NOERR) THEN
    204          write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
    205          CALL abort_gcm("dynetat0", "", 1)
    206       ENDIF
    207 #ifdef NC_DOUBLE
    208       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, rlatv)
    209 #else
    210       ierr = NF_GET_VAR_REAL(nid, nvarid, rlatv)
    211 #endif
    212       IF (ierr .NE. NF_NOERR) THEN
    213          write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
    214          CALL abort_gcm("dynetat0", "", 1)
    215       ENDIF
    216 
    217       ierr = NF_INQ_VARID (nid, "cu", nvarid)
    218       IF (ierr .NE. NF_NOERR) THEN
    219          write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
    220          CALL abort_gcm("dynetat0", "", 1)
    221       ENDIF
    222 #ifdef NC_DOUBLE
    223       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cu)
    224 #else
    225       ierr = NF_GET_VAR_REAL(nid, nvarid, cu)
    226 #endif
    227       IF (ierr .NE. NF_NOERR) THEN
    228          write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
    229          CALL abort_gcm("dynetat0", "", 1)
    230       ENDIF
    231 
    232       ierr = NF_INQ_VARID (nid, "cv", nvarid)
    233       IF (ierr .NE. NF_NOERR) THEN
    234          write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
    235          CALL abort_gcm("dynetat0", "", 1)
    236       ENDIF
    237 #ifdef NC_DOUBLE
    238       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, cv)
    239 #else
    240       ierr = NF_GET_VAR_REAL(nid, nvarid, cv)
    241 #endif
    242       IF (ierr .NE. NF_NOERR) THEN
    243          write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
    244          CALL abort_gcm("dynetat0", "", 1)
    245       ENDIF
    246 
    247       ierr = NF_INQ_VARID (nid, "aire", nvarid)
    248       IF (ierr .NE. NF_NOERR) THEN
    249          write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
    250          CALL abort_gcm("dynetat0", "", 1)
    251       ENDIF
    252 #ifdef NC_DOUBLE
    253       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, aire)
    254 #else
    255       ierr = NF_GET_VAR_REAL(nid, nvarid, aire)
    256 #endif
    257       IF (ierr .NE. NF_NOERR) THEN
    258          write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
    259          CALL abort_gcm("dynetat0", "", 1)
    260       ENDIF
    261      
    262       ALLOCATE(phis_glo(ip1jmp1))
    263      
    264       ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
    265       IF (ierr .NE. NF_NOERR) THEN
    266          write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
    267          CALL abort_gcm("dynetat0", "", 1)
    268       ENDIF
    269 #ifdef NC_DOUBLE
    270       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, phis_glo)
    271 #else
    272       ierr = NF_GET_VAR_REAL(nid, nvarid, phis_glo)
    273 #endif
    274       IF (ierr .NE. NF_NOERR) THEN
    275          write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
    276          CALL abort_gcm("dynetat0", "", 1)
    277       ENDIF
    278       phis(ijb_u:ije_u)=phis_glo(ijb_u:ije_u)
    279       DEALLOCATE(phis_glo)
    280 
    281       ierr = NF_INQ_VARID (nid, "temps", nvarid)
    282       IF (ierr .NE. NF_NOERR) THEN
    283          write(lunout,*)"dynetat0: Le champ <temps> est absent"
    284          write(lunout,*)"dynetat0: J essaie <Time>"
    285          ierr = NF_INQ_VARID (nid, "Time", nvarid)
    286          IF (ierr .NE. NF_NOERR) THEN
    287             write(lunout,*)"dynetat0: Le champ <Time> est absent"
    288             CALL abort_gcm("dynetat0", "", 1)
    289          ENDIF
    290       ENDIF
    291 #ifdef NC_DOUBLE
    292       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, time)
    293 #else
    294       ierr = NF_GET_VAR_REAL(nid, nvarid, time)
    295 #endif
    296       IF (ierr .NE. NF_NOERR) THEN
    297          write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
    298          CALL abort_gcm("dynetat0", "", 1)
    299       ENDIF
    300 
    301       ierr = NF_INQ_VARID (nid, "ucov", nvarid)
    302       IF (ierr .NE. NF_NOERR) THEN
    303          write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
    304          CALL abort_gcm("dynetat0", "", 1)
    305       ENDIF
    306      
    307       ALLOCATE(ucov_glo(ip1jmp1,llm))
    308      
    309 #ifdef NC_DOUBLE
    310       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ucov_glo)
    311 #else
    312       ierr = NF_GET_VAR_REAL(nid, nvarid, ucov_glo)
    313 #endif
    314       IF (ierr .NE. NF_NOERR) THEN
    315          write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
    316          CALL abort_gcm("dynetat0", "", 1)
    317       ENDIF
    318 
    319       ucov(ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:)
    320       DEALLOCATE(ucov_glo)
    321       ALLOCATE(vcov_glo(ip1jm,llm))
    322      
    323       ierr = NF_INQ_VARID (nid, "vcov", nvarid)
    324       IF (ierr .NE. NF_NOERR) THEN
    325          write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
    326          CALL abort_gcm("dynetat0", "", 1)
    327       ENDIF
    328 #ifdef NC_DOUBLE
    329       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, vcov_glo)
    330 #else
    331       ierr = NF_GET_VAR_REAL(nid, nvarid, vcov_glo)
    332 #endif
    333       IF (ierr .NE. NF_NOERR) THEN
    334          write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
    335          CALL abort_gcm("dynetat0", "", 1)
    336       ENDIF
    337       vcov(ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:)
    338       DEALLOCATE(vcov_glo)
    339       ALLOCATE(teta_glo(ip1jmp1,llm))
    340 
    341       ierr = NF_INQ_VARID (nid, "teta", nvarid)
    342       IF (ierr .NE. NF_NOERR) THEN
    343          write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
    344          CALL abort_gcm("dynetat0", "", 1)
    345       ENDIF
    346 #ifdef NC_DOUBLE
    347       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, teta_glo)
    348 #else
    349       ierr = NF_GET_VAR_REAL(nid, nvarid, teta_glo)
    350 #endif
    351       IF (ierr .NE. NF_NOERR) THEN
    352          write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
    353          CALL abort_gcm("dynetat0", "", 1)
    354       ENDIF
    355 
    356       teta(ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:)
    357       DEALLOCATE(teta_glo)
    358       ALLOCATE(q_glo(ip1jmp1,llm))
    359 
    360 
    361       DO iq=1,nqtot
    362         ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    363         IF (ierr .NE. NF_NOERR) THEN
    364            write(lunout,*)"dynetat0_loc: Le traceur <"                  &
    365      &     //trim(tname(iq))//"> est absent"
    366            write(lunout,*)"Il est donc initialise a zero"
    367            q(:,:,iq)=0.
    368 
    369            ! CRisi: pour les isotopes, on peut faire init théorique
    370            ! distill de Rayleigh très simplifiée
    371            if (ok_isotopes) then
    372               if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.0)) then
    373                 q(:,:,iq)=q(:,:,iqpere(iq))                             &
    374      &                   *tnat(iso_num(iq))                             &
    375      &                   *(q(:,:,iqpere(iq))/30.e-3)                    &
    376      &                   **(alpha_ideal(iso_num(iq))-1)
    377               endif
    378               if ((iso_num(iq).gt.0).and.(zone_num(iq).eq.1)) then
    379                   q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
    380               endif 
    381            endif !if (ok_isotopes) then       
    382 
    383         ELSE
    384 #ifdef NC_DOUBLE
    385           ierr = NF_GET_VAR_DOUBLE(nid, nvarid, q_glo)
    386 #else
    387           ierr = NF_GET_VAR_REAL(nid, nvarid, q_glo)
    388 #endif
    389           IF (ierr .NE. NF_NOERR) THEN
    390             write(lunout,*)
    391      &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
    392             CALL abort_gcm("dynetat0", "", 1)
    393           ENDIF
    394         q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:)
    395 
    396         ENDIF
    397       ENDDO !DO iq=1,nqtot
    398 
    399       if (ok_iso_verif) then
    400          call check_isotopes(q,ijb_u,ije_u,'dynetat0_loc')
    401       endif !if (ok_iso_verif) then
    402 
    403       DEALLOCATE(q_glo)
    404       ALLOCATE(masse_glo(ip1jmp1,llm))
    405 
    406       ierr = NF_INQ_VARID (nid, "masse", nvarid)
    407       IF (ierr .NE. NF_NOERR) THEN
    408          write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
    409          CALL abort_gcm("dynetat0", "", 1)
    410       ENDIF
    411 #ifdef NC_DOUBLE
    412       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, masse_glo)
    413 #else
    414       ierr = NF_GET_VAR_REAL(nid, nvarid, masse_glo)
    415 #endif
    416       IF (ierr .NE. NF_NOERR) THEN
    417          write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
    418          CALL abort_gcm("dynetat0", "", 1)
    419       ENDIF
    420       masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:)
    421       DEALLOCATE(masse_glo)
    422       ALLOCATE(ps_glo(ip1jmp1))
    423 
    424       ierr = NF_INQ_VARID (nid, "ps", nvarid)
    425       IF (ierr .NE. NF_NOERR) THEN
    426          write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
    427          CALL abort_gcm("dynetat0", "", 1)
    428       ENDIF
    429 #ifdef NC_DOUBLE
    430       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, ps_glo)
    431 #else
    432       ierr = NF_GET_VAR_REAL(nid, nvarid, ps_glo)
    433 #endif
    434       IF (ierr .NE. NF_NOERR) THEN
    435          write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
    436          CALL abort_gcm("dynetat0", "", 1)
    437       ENDIF
    438 
    439       ps(ijb_u:ije_u)=ps_glo(ijb_u:ije_u)
    440       DEALLOCATE(ps_glo)
    441 
    442       ierr = NF_CLOSE(nid)
    443 
    444        day_ini=day_ini+INT(time)
    445        time=time-INT(time)
    446 
    447   1   FORMAT(//10x,'la valeur de im =',i4,2x,'lue sur le fichier de dem
    448      *arrage est differente de la valeur parametree iim =',i4//)
    449    2  FORMAT(//10x,'la valeur de jm =',i4,2x,'lue sur le fichier de dem
    450      *arrage est differente de la valeur parametree jjm =',i4//)
    451    3  FORMAT(//10x,'la valeur de lmax =',i4,2x,'lue sur le fichier dema
    452      *rrage est differente de la valeur parametree llm =',i4//)
    453    4  FORMAT(//10x,'la valeur de dtrv =',i4,2x,'lue sur le fichier dema
    454      *rrage est differente de la valeur  dtinteg =',i4//)
    455 
    456       RETURN
    457       END
     83  clon       = tab_cntrl(idecal+15)
     84  clat       = tab_cntrl(idecal+16)
     85  grossismx  = tab_cntrl(idecal+17)
     86  grossismy  = tab_cntrl(idecal+18)
     87!
     88  IF ( tab_cntrl(idecal+19)==1. )  THEN
     89    fxyhypb  = .TRUE.
     90!   dzoomx   = tab_cntrl(25)
     91!   dzoomy   = tab_cntrl(26)
     92!   taux     = tab_cntrl(28)
     93!   tauy     = tab_cntrl(29)
     94  ELSE
     95    fxyhypb = .FALSE.
     96    ysinus  = tab_cntrl(idecal+22)==1.
     97  END IF
     98
     99  day_ini    = tab_cntrl(30)
     100  itau_dyn   = tab_cntrl(31)
     101!  start_time = tab_cntrl(32)   ????
     102
     103!-------------------------------------------------------------------------------
     104  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
     105  CALL check_dim(im,iim,'im','im')
     106  CALL check_dim(jm,jjm,'jm','jm')
     107  CALL check_dim(lllm,llm,'lm','lllm')
     108  CALL get_var1("rlonu",rlonu)
     109  CALL get_var1("rlatu",rlatu)
     110  CALL get_var1("rlonv",rlonv)
     111  CALL get_var1("rlatv",rlatv)
     112  CALL get_var1("cu"  ,cu)
     113  CALL get_var1("cv"  ,cv)
     114  CALL get_var1("aire",aire)
     115
     116  var="temps"
     117  IF(NF90_INQ_VARID(fID,var,vID)/=NF90_NoErr) THEN
     118    WRITE(lunout,*)TRIM(modname)//": missing field <temps>"
     119    WRITE(lunout,*)TRIM(modname)//": trying with <Time>"; var="Time"
     120    CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
     121  END IF
     122  CALL err(NF90_GET_VAR(fID,vID,time),"get",var)
     123
     124  ALLOCATE(phis_glo(ip1jmp1))
     125  CALL get_var1("phisinit",phis_glo)
     126  phis (ijb_u:ije_u)  =phis_glo(ijb_u:ije_u);    DEALLOCATE(phis_glo)
     127
     128  ALLOCATE(ucov_glo(ip1jmp1,llm))
     129  CALL get_var2("ucov",ucov_glo)
     130  ucov (ijb_u:ije_u,:)=ucov_glo(ijb_u:ije_u,:);  DEALLOCATE(ucov_glo)
     131
     132  ALLOCATE(vcov_glo(ip1jm,llm))
     133  CALL get_var2("vcov",vcov_glo)
     134  vcov (ijb_v:ije_v,:)=vcov_glo(ijb_v:ije_v,:);  DEALLOCATE(vcov_glo)
     135
     136  ALLOCATE(teta_glo(ip1jmp1,llm))
     137  CALL get_var2("teta",teta_glo)
     138  teta (ijb_u:ije_u,:)=teta_glo(ijb_u:ije_u,:);  DEALLOCATE(teta_glo)
     139
     140  ALLOCATE(masse_glo(ip1jmp1,llm))
     141  CALL get_var2("masse",masse_glo)
     142  masse(ijb_u:ije_u,:)=masse_glo(ijb_u:ije_u,:); DEALLOCATE(masse_glo)
     143 
     144  ALLOCATE(ps_glo(ip1jmp1))
     145  CALL get_var1("ps",ps_glo)
     146  ps   (ijb_u:ije_u)  =   ps_glo(ijb_u:ije_u);   DEALLOCATE(ps_glo)
     147
     148!--- Tracers
     149  ALLOCATE(q_glo(ip1jmp1,llm))
     150  DO iq=1,nqtot
     151    var=tname(iq)
     152    IF(NF90_INQ_VARID(fID,var,vID)==NF90_NoErr) THEN
     153      CALL get_var2(var,q_glo); q(ijb_u:ije_u,:,iq)=q_glo(ijb_u:ije_u,:); CYCLE
     154    END IF
     155    WRITE(lunout,*)TRIM(modname)//": Tracer <"//TRIM(var)//"> is missing"
     156    WRITE(lunout,*)"         It is hence initialized to zero"
     157    q(ijb_u:ije_u,:,iq)=0.
     158   !--- CRisi: for isotops, theoretical initialization using very simplified
     159   !           Rayleigh distillation las.
     160    IF(ok_isotopes.AND.iso_num(iq)>0) THEN
     161      IF(zone_num(iq)==0) q(:,:,iq)=q(:,:,iqpere(iq))*tnat(iso_num(iq))        &
     162     &           *(q(:,:,iqpere(iq))/30.e-3)**(alpha_ideal(iso_num(iq))-1)
     163      IF(zone_num(iq)==1) q(:,:,iq)=q(:,:,iqiso(iso_indnum(iq),phase_num(iq)))
     164    END IF
     165  END DO
     166  DEALLOCATE(q_glo)
     167  CALL err(NF90_CLOSE(fID),"close",fichnom)
     168  day_ini=day_ini+INT(time)
     169  time=time-INT(time)
     170
     171
     172  CONTAINS
     173
     174
     175SUBROUTINE check_dim(n1,n2,str1,str2)
     176  INTEGER,          INTENT(IN) :: n1, n2
     177  CHARACTER(LEN=*), INTENT(IN) :: str1, str2
     178  CHARACTER(LEN=256) :: s1, s2
     179  IF(n1/=n2) THEN
     180    s1='value of '//TRIM(str1)//' ='
     181    s2=' read in starting file differs from parametrized '//TRIM(str2)//' ='
     182    WRITE(msg,'(10x,a,i4,2x,a,i4)'),s1,n1,s2,n2
     183    CALL ABORT_gcm(TRIM(modname),TRIM(msg),1)
     184  END IF
     185END SUBROUTINE check_dim
     186
     187
     188SUBROUTINE get_var1(var,v)
     189  CHARACTER(LEN=*), INTENT(IN)  :: var
     190  REAL,             INTENT(OUT) :: v(:)
     191  REAL,             ALLOCATABLE :: w2(:,:), w3(:,:,:)
     192  INTEGER :: nn(3), dids(3), k, nd, ntot
     193
     194  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
     195  ierr=NF90_INQUIRE_VARIABLE(fID,vID,ndims=nd)
     196  IF(nd==1) THEN
     197    CALL err(NF90_GET_VAR(fID,vID,v),"get",var); RETURN
     198  END IF
     199  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids)
     200  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
     201  ntot=PRODUCT(nn(1:nd))
     202  SELECT CASE(nd)
     203    CASE(2); ALLOCATE(w2(nn(1),nn(2)))
     204      CALL err(NF90_GET_VAR(fID,vID,w2),"get",var)
     205      v=RESHAPE(w2,[ntot]); DEALLOCATE(w2)
     206    CASE(3); ALLOCATE(w3(nn(1),nn(2),nn(3)))
     207      CALL err(NF90_GET_VAR(fID,vID,w3),"get",var)
     208      v=RESHAPE(w3,[ntot]); DEALLOCATE(w3)
     209  END SELECT
     210END SUBROUTINE get_var1
     211
     212
     213SUBROUTINE get_var2(var,v)
     214  CHARACTER(LEN=*), INTENT(IN)  :: var
     215  REAL,             INTENT(OUT) :: v(:,:)
     216  REAL,             ALLOCATABLE :: w4(:,:,:,:)
     217  INTEGER :: nn(4), dids(4), k, nd
     218  CALL err(NF90_INQ_VARID(fID,var,vID),"inq",var)
     219  ierr=NF90_INQUIRE_VARIABLE(fID,vID,dimids=dids,ndims=nd)
     220  DO k=1,nd; ierr=NF90_INQUIRE_DIMENSION(fID,dids(k),len=nn(k)); END DO
     221  ALLOCATE(w4(nn(1),nn(2),nn(3),nn(4)))
     222  CALL err(NF90_GET_VAR(fID,vID,w4),"get",var)
     223  v=RESHAPE(w4,[nn(1)*nn(2),nn(3)]); DEALLOCATE(w4)
     224END SUBROUTINE get_var2
     225
     226
     227SUBROUTINE err(ierr,typ,nam)
     228  INTEGER,          INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
     229  CHARACTER(LEN=*), INTENT(IN) :: typ    !--- TYPE OF OPERATION
     230  CHARACTER(LEN=*), INTENT(IN) :: nam    !--- FIELD/FILE NAME
     231  IF(ierr==NF90_NoERR) RETURN
     232  SELECT CASE(typ)
     233    CASE('inq');   msg="Field <"//TRIM(nam)//"> is missing"
     234    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
     235    CASE('open');  msg="File opening failed for <"//TRIM(nam)//">"
     236    CASE('close'); msg="File closing failed for <"//TRIM(nam)//">"
     237  END SELECT
     238  CALL ABORT_gcm(TRIM(modname),TRIM(msg),ierr)
     239END SUBROUTINE err
     240
     241END SUBROUTINE dynetat0_loc

  • LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F90

    r2298 r2299  
    1 !
    2 ! $Id$
    3 !
    4 c
    5       SUBROUTINE dynredem0_loc(fichnom,iday_end,phis)
     1SUBROUTINE dynredem0_loc(fichnom,iday_end,phis)
     2!
     3!-------------------------------------------------------------------------------
     4! Write the NetCDF restart file (initialization).
     5!-------------------------------------------------------------------------------
    66#ifdef CPP_IOIPSL
    7       USE IOIPSL
     7  USE IOIPSL
    88#endif
    9       USE parallel_lmdz
    10       USE mod_hallo
    11       USE infotrac
    12       IMPLICIT NONE
    13 c=======================================================================
    14 c Ecriture du fichier de redemarrage sous format NetCDF (initialisation)
    15 c=======================================================================
    16 c   Declarations:
    17 c   -------------
    18 #include "dimensions.h"
    19 #include "paramet.h"
    20 #include "comconst.h"
    21 #include "comvert.h"
    22 #include "comgeom.h"
    23 #include "temps.h"
    24 #include "ener.h"
    25 #include "logic.h"
    26 #include "netcdf.inc"
    27 #include "description.h"
    28 #include "serre.h"
    29 #include "iniprint.h"
    30 
    31 c   Arguments:
    32 c   ----------
    33       INTEGER iday_end
    34       REAL phis(ijb_u:ije_u)
    35       CHARACTER*(*) fichnom
    36 
    37 c   Local:
    38 c   ------
    39       INTEGER iq,l
    40       INTEGER length
    41       PARAMETER (length = 100)
    42       REAL tab_cntrl(length) ! tableau des parametres du run
    43       INTEGER ierr
    44       character*20 modname
    45       character*80 abort_message
    46 
    47 c   Variables locales pour NetCDF:
    48 c
    49       INTEGER dims2(2), dims3(3), dims4(4)
    50       INTEGER idim_index
    51       INTEGER idim_rlonu, idim_rlonv, idim_rlatu, idim_rlatv
    52       INTEGER idim_s, idim_sig
    53       INTEGER idim_tim
    54       INTEGER nid,nvarid
    55 
    56       REAL zan0,zjulian,hours
    57       INTEGER yyears0,jjour0, mmois0
    58       character*30 unites
    59       REAL :: phis_glo(ip1jmp1)
    60      
    61       CALL Gather_field_u(phis,phis_glo,1)
    62      
    63      
    64 c-----------------------------------------------------------------------
    65       if (mpi_rank==0) then
    66      
    67       modname='dynredem0_loc'
     9  USE parallel_lmdz
     10  USE mod_hallo
     11  USE infotrac
     12  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
     13                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
     14  USE dynredem_mod, ONLY: cre_var, put_var, err, modname, fil
     15  IMPLICIT NONE
     16  include "dimensions.h"
     17  include "paramet.h"
     18  include "comconst.h"
     19  include "comvert.h"
     20  include "comgeom.h"
     21  include "temps.h"
     22  include "ener.h"
     23  include "logic.h"
     24  include "description.h"
     25  include "serre.h"
     26  include "iniprint.h"
     27!===============================================================================
     28! Arguments:
     29  CHARACTER(LEN=*), INTENT(IN) :: fichnom          !--- FILE NAME
     30  INTEGER,          INTENT(IN) :: iday_end         !---
     31  REAL,             INTENT(IN) :: phis(ijb_u:ije_u)!--- GROUND GEOPOTENTIAL
     32!===============================================================================
     33! Local variables:
     34  INTEGER :: iq, l
     35  INTEGER, PARAMETER :: length=100
     36  REAL    :: tab_cntrl(length)                     !--- RUN PARAMETERS TABLE
     37  REAL    :: phis_glo(ip1jmp1)
     38!   For NetCDF:
     39  CHARACTER(LEN=30) :: unites
     40  INTEGER :: indexID
     41  INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
     42  INTEGER :: sID, sigID, nID, vID, timID
     43  INTEGER :: yyears0, jjour0, mmois0
     44  REAL    :: zan0, zjulian, hours
     45!===============================================================================
     46  modname='dynredem0'; fil=fichnom
     47  CALL Gather_field_u(phis,phis_glo,1)
     48  IF(mpi_rank/=0) RETURN
    6849
    6950#ifdef CPP_IOIPSL
    70       call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
    71       call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
     51  CALL ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
     52  CALL ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
    7253#else
    7354! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
    74       yyears0=0
    75       mmois0=1
    76       jjour0=1
    77 #endif               
    78 
    79       DO l=1,length
    80        tab_cntrl(l) = 0.
    81       ENDDO
    82        tab_cntrl(1)  =  REAL(iim)
    83        tab_cntrl(2)  =  REAL(jjm)
    84        tab_cntrl(3)  =  REAL(llm)
    85        tab_cntrl(4)  =  REAL(day_ref)
    86        tab_cntrl(5)  =  REAL(annee_ref)
    87        tab_cntrl(6)  = rad
    88        tab_cntrl(7)  = omeg
    89        tab_cntrl(8)  = g
    90        tab_cntrl(9)  = cpp
    91        tab_cntrl(10) = kappa
    92        tab_cntrl(11) = daysec
    93        tab_cntrl(12) = dtvr
    94        tab_cntrl(13) = etot0
    95        tab_cntrl(14) = ptot0
    96        tab_cntrl(15) = ztot0
    97        tab_cntrl(16) = stot0
    98        tab_cntrl(17) = ang0
    99        tab_cntrl(18) = pa
    100        tab_cntrl(19) = preff
    101 c
    102 c    .....    parametres  pour le zoom      ......   
    103 
    104        tab_cntrl(20)  = clon
    105        tab_cntrl(21)  = clat
    106        tab_cntrl(22)  = grossismx
    107        tab_cntrl(23)  = grossismy
    108 c
    109       IF ( fxyhypb )   THEN
    110        tab_cntrl(24) = 1.
    111        tab_cntrl(25) = dzoomx
    112        tab_cntrl(26) = dzoomy
    113        tab_cntrl(27) = 0.
    114        tab_cntrl(28) = taux
    115        tab_cntrl(29) = tauy
    116       ELSE
    117        tab_cntrl(24) = 0.
    118        tab_cntrl(25) = dzoomx
    119        tab_cntrl(26) = dzoomy
    120        tab_cntrl(27) = 0.
    121        tab_cntrl(28) = 0.
    122        tab_cntrl(29) = 0.
    123        IF( ysinus )  tab_cntrl(27) = 1.
    124       ENDIF
    125 
    126        tab_cntrl(30) =  REAL(iday_end)
    127        tab_cntrl(31) =  REAL(itau_dyn + itaufin)
    128 c start_time: start_time of simulation (not necessarily 0.)
    129        tab_cntrl(32) = start_time
    130 c
    131 c    .........................................................
    132 c
    133 c Creation du fichier:
    134 c
    135       ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
    136       IF (ierr.NE.NF_NOERR) THEN
    137          write(lunout,*)"dynredem0: Pb d ouverture du fichier "
    138      &                  //trim(fichnom)
    139          write(lunout,*)' ierr = ', ierr
    140          CALL ABORT_GCM("DYNREDEM0", "", 1)
    141       ENDIF
    142 c
    143 c Preciser quelques attributs globaux:
    144 c
    145       ierr = NF_PUT_ATT_TEXT (nid, NF_GLOBAL, "title", 27,
    146      .                       "Fichier demmarage dynamique")
    147 c
    148 c Definir les dimensions du fichiers:
    149 c
    150       ierr = NF_DEF_DIM (nid, "index", length, idim_index)
    151       ierr = NF_DEF_DIM (nid, "rlonu", iip1, idim_rlonu)
    152       ierr = NF_DEF_DIM (nid, "rlatu", jjp1, idim_rlatu)
    153       ierr = NF_DEF_DIM (nid, "rlonv", iip1, idim_rlonv)
    154       ierr = NF_DEF_DIM (nid, "rlatv", jjm, idim_rlatv)
    155       ierr = NF_DEF_DIM (nid, "sigs", llm, idim_s)
    156       ierr = NF_DEF_DIM (nid, "sig", llmp1, idim_sig)
    157       ierr = NF_DEF_DIM (nid, "temps", NF_UNLIMITED, idim_tim)
    158 c
    159       ierr = NF_ENDDEF(nid) ! sortir du mode de definition
    160 c
    161 c Definir et enregistrer certains champs invariants:
    162 c
    163       ierr = NF_REDEF (nid)
    164 cIM 220306 BEG
    165 #ifdef NC_DOUBLE
    166       ierr = NF_DEF_VAR (nid,"controle",NF_DOUBLE,1,idim_index,nvarid)
    167 #else
    168       ierr = NF_DEF_VAR (nid,"controle",NF_FLOAT,1,idim_index,nvarid)
    169 #endif
    170 cIM 220306 END
    171       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    172      .                       "Parametres de controle")
    173       ierr = NF_ENDDEF(nid)
    174 #ifdef NC_DOUBLE
    175       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
    176 #else
    177       ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
    178 #endif
    179 c
    180       ierr = NF_REDEF (nid)
    181 cIM 220306 BEG
    182 #ifdef NC_DOUBLE
    183       ierr = NF_DEF_VAR (nid,"rlonu",NF_DOUBLE,1,idim_rlonu,nvarid)
    184 #else
    185       ierr = NF_DEF_VAR (nid,"rlonu",NF_FLOAT,1,idim_rlonu,nvarid)
    186 #endif
    187 cIM 220306 END
    188       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
    189      .                       "Longitudes des points U")
    190       ierr = NF_ENDDEF(nid)
    191 #ifdef NC_DOUBLE
    192       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonu)
    193 #else
    194       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonu)
    195 #endif
    196 c
    197       ierr = NF_REDEF (nid)
    198 cIM 220306 BEG
    199 #ifdef NC_DOUBLE
    200       ierr = NF_DEF_VAR (nid,"rlatu",NF_DOUBLE,1,idim_rlatu,nvarid)
    201 #else
    202       ierr = NF_DEF_VAR (nid,"rlatu",NF_FLOAT,1,idim_rlatu,nvarid)
    203 #endif
    204 cIM 220306 END
    205       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    206      .                       "Latitudes des points U")
    207       ierr = NF_ENDDEF(nid)
    208 #ifdef NC_DOUBLE
    209       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatu)
    210 #else
    211       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatu)
    212 #endif
    213 c
    214       ierr = NF_REDEF (nid)
    215 cIM 220306 BEG
    216 #ifdef NC_DOUBLE
    217       ierr = NF_DEF_VAR (nid,"rlonv",NF_DOUBLE,1,idim_rlonv,nvarid)
    218 #else
    219       ierr = NF_DEF_VAR (nid,"rlonv",NF_FLOAT,1,idim_rlonv,nvarid)
    220 #endif
    221 cIM 220306 END
    222       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 23,
    223      .                       "Longitudes des points V")
    224       ierr = NF_ENDDEF(nid)
    225 #ifdef NC_DOUBLE
    226       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlonv)
    227 #else
    228       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlonv)
    229 #endif
    230 c
    231       ierr = NF_REDEF (nid)
    232 cIM 220306 BEG
    233 #ifdef NC_DOUBLE
    234       ierr = NF_DEF_VAR (nid,"rlatv",NF_DOUBLE,1,idim_rlatv,nvarid)
    235 #else
    236       ierr = NF_DEF_VAR (nid,"rlatv",NF_FLOAT,1,idim_rlatv,nvarid)
    237 #endif
    238 cIM 220306 END
    239       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    240      .                       "Latitudes des points V")
    241       ierr = NF_ENDDEF(nid)
    242 #ifdef NC_DOUBLE
    243       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,rlatv)
    244 #else
    245       ierr = NF_PUT_VAR_REAL (nid,nvarid,rlatv)
    246 #endif
    247 c
    248       ierr = NF_REDEF (nid)
    249 cIM 220306 BEG
    250 #ifdef NC_DOUBLE
    251       ierr = NF_DEF_VAR (nid,"nivsigs",NF_DOUBLE,1,idim_s,nvarid)
    252 #else
    253       ierr = NF_DEF_VAR (nid,"nivsigs",NF_FLOAT,1,idim_s,nvarid)
    254 #endif
    255 cIM 220306 END
    256       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 28,
    257      .                       "Numero naturel des couches s")
    258       ierr = NF_ENDDEF(nid)
    259 #ifdef NC_DOUBLE
    260       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsigs)
    261 #else
    262       ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsigs)
    263 #endif
    264 c
    265       ierr = NF_REDEF (nid)
    266 cIM 220306 BEG
    267 #ifdef NC_DOUBLE
    268       ierr = NF_DEF_VAR (nid,"nivsig",NF_DOUBLE,1,idim_sig,nvarid)
    269 #else
    270       ierr = NF_DEF_VAR (nid,"nivsig",NF_FLOAT,1,idim_sig,nvarid)
    271 #endif
    272 cIM 220306 END
    273       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 32,
    274      .                       "Numero naturel des couches sigma")
    275       ierr = NF_ENDDEF(nid)
    276 #ifdef NC_DOUBLE
    277       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,nivsig)
    278 #else
    279       ierr = NF_PUT_VAR_REAL (nid,nvarid,nivsig)
    280 #endif
    281 c
    282       ierr = NF_REDEF (nid)
    283 cIM 220306 BEG
    284 #ifdef NC_DOUBLE
    285       ierr = NF_DEF_VAR (nid,"ap",NF_DOUBLE,1,idim_sig,nvarid)
    286 #else
    287       ierr = NF_DEF_VAR (nid,"ap",NF_FLOAT,1,idim_sig,nvarid)
    288 #endif
    289 cIM 220306 END
    290       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
    291      .                       "Coefficient A pour hybride")
    292       ierr = NF_ENDDEF(nid)
    293 #ifdef NC_DOUBLE
    294       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,ap)
    295 #else
    296       ierr = NF_PUT_VAR_REAL (nid,nvarid,ap)
    297 #endif
    298 c
    299       ierr = NF_REDEF (nid)
    300 cIM 220306 BEG
    301 #ifdef NC_DOUBLE
    302       ierr = NF_DEF_VAR (nid,"bp",NF_DOUBLE,1,idim_sig,nvarid)
    303 #else
    304       ierr = NF_DEF_VAR (nid,"bp",NF_FLOAT,1,idim_sig,nvarid)
    305 #endif
    306 cIM 220306 END
    307       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 26,
    308      .                       "Coefficient B pour hybride")
    309       ierr = NF_ENDDEF(nid)
    310 #ifdef NC_DOUBLE
    311       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,bp)
    312 #else
    313       ierr = NF_PUT_VAR_REAL (nid,nvarid,bp)
    314 #endif
    315 c
    316       ierr = NF_REDEF (nid)
    317 cIM 220306 BEG
    318 #ifdef NC_DOUBLE
    319       ierr = NF_DEF_VAR (nid,"presnivs",NF_DOUBLE,1,idim_s,nvarid)
    320 #else
    321       ierr = NF_DEF_VAR (nid,"presnivs",NF_FLOAT,1,idim_s,nvarid)
    322 #endif
    323 cIM 220306 END
    324       ierr = NF_ENDDEF(nid)
    325 #ifdef NC_DOUBLE
    326       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,presnivs)
    327 #else
    328       ierr = NF_PUT_VAR_REAL (nid,nvarid,presnivs)
    329 #endif
    330 c
    331 c Coefficients de passage cov. <-> contra. <--> naturel
    332 c
    333       ierr = NF_REDEF (nid)
    334       dims2(1) = idim_rlonu
    335       dims2(2) = idim_rlatu
    336 cIM 220306 BEG
    337 #ifdef NC_DOUBLE
    338       ierr = NF_DEF_VAR (nid,"cu",NF_DOUBLE,2,dims2,nvarid)
    339 #else
    340       ierr = NF_DEF_VAR (nid,"cu",NF_FLOAT,2,dims2,nvarid)
    341 #endif
    342 cIM 220306 END
    343       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
    344      .                       "Coefficient de passage pour U")
    345       ierr = NF_ENDDEF(nid)
    346 #ifdef NC_DOUBLE
    347       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cu)
    348 #else
    349       ierr = NF_PUT_VAR_REAL (nid,nvarid,cu)
    350 #endif
    351 c
    352       ierr = NF_REDEF (nid)
    353       dims2(1) = idim_rlonv
    354       dims2(2) = idim_rlatv
    355 cIM 220306 BEG
    356 #ifdef NC_DOUBLE
    357       ierr = NF_DEF_VAR (nid,"cv",NF_DOUBLE,2,dims2,nvarid)
    358 #else
    359       ierr = NF_DEF_VAR (nid,"cv",NF_FLOAT,2,dims2,nvarid)
    360 #endif
    361 cIM 220306 END
    362       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 29,
    363      .                       "Coefficient de passage pour V")
    364       ierr = NF_ENDDEF(nid)
    365 #ifdef NC_DOUBLE
    366       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,cv)
    367 #else
    368       ierr = NF_PUT_VAR_REAL (nid,nvarid,cv)
    369 #endif
    370 c
    371 c Aire de chaque maille:
    372 c
    373       ierr = NF_REDEF (nid)
    374       dims2(1) = idim_rlonv
    375       dims2(2) = idim_rlatu
    376 cIM 220306 BEG
    377 #ifdef NC_DOUBLE
    378       ierr = NF_DEF_VAR (nid,"aire",NF_DOUBLE,2,dims2,nvarid)
    379 #else
    380       ierr = NF_DEF_VAR (nid,"aire",NF_FLOAT,2,dims2,nvarid)
    381 #endif
    382 cIM 220306 END
    383       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 22,
    384      .                       "Aires de chaque maille")
    385       ierr = NF_ENDDEF(nid)
    386 #ifdef NC_DOUBLE
    387       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,aire)
    388 #else
    389       ierr = NF_PUT_VAR_REAL (nid,nvarid,aire)
    390 #endif
    391 c
    392 c Geopentiel au sol:
    393 c
    394       ierr = NF_REDEF (nid)
    395       dims2(1) = idim_rlonv
    396       dims2(2) = idim_rlatu
    397 cIM 220306 BEG
    398 #ifdef NC_DOUBLE
    399       ierr = NF_DEF_VAR (nid,"phisinit",NF_DOUBLE,2,dims2,nvarid)
    400 #else
    401       ierr = NF_DEF_VAR (nid,"phisinit",NF_FLOAT,2,dims2,nvarid)
    402 #endif
    403 cIM 220306 END
    404       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
    405      .                       "Geopotentiel au sol")
    406       ierr = NF_ENDDEF(nid)
    407 #ifdef NC_DOUBLE
    408       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,phis_glo)
    409 #else
    410       ierr = NF_PUT_VAR_REAL (nid,nvarid,phis_glo)
    411 #endif
    412 c
    413 c Definir les variables pour pouvoir les enregistrer plus tard:
    414 c
    415       ierr = NF_REDEF (nid) ! entrer dans le mode de definition
    416 c
    417 cIM 220306 BEG
    418 #ifdef NC_DOUBLE
    419       ierr = NF_DEF_VAR (nid,"temps",NF_DOUBLE,1,idim_tim,nvarid)
    420 #else
    421       ierr = NF_DEF_VAR (nid,"temps",NF_FLOAT,1,idim_tim,nvarid)
    422 #endif
    423 cIM 220306 END
    424       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 19,
    425      .                       "Temps de simulation")
    426       write(unites,200)yyears0,mmois0,jjour0
    427 200   format('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')
    428       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "units", 30,
    429      .                         unites)
    430 
    431 c
    432       dims4(1) = idim_rlonu
    433       dims4(2) = idim_rlatu
    434       dims4(3) = idim_s
    435       dims4(4) = idim_tim
    436 cIM 220306 BEG
    437 #ifdef NC_DOUBLE
    438       ierr = NF_DEF_VAR (nid,"ucov",NF_DOUBLE,4,dims4,nvarid)
    439 #else
    440       ierr = NF_DEF_VAR (nid,"ucov",NF_FLOAT,4,dims4,nvarid)
    441 #endif
    442 cIM 220306 END
    443       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
    444      .                       "Vitesse U")
    445 c
    446       dims4(1) = idim_rlonv
    447       dims4(2) = idim_rlatv
    448       dims4(3) = idim_s
    449       dims4(4) = idim_tim
    450 cIM 220306 BEG
    451 #ifdef NC_DOUBLE
    452       ierr = NF_DEF_VAR (nid,"vcov",NF_DOUBLE,4,dims4,nvarid)
    453 #else
    454       ierr = NF_DEF_VAR (nid,"vcov",NF_FLOAT,4,dims4,nvarid)
    455 #endif
    456 cIM 220306 END
    457       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 9,
    458      .                       "Vitesse V")
    459 c
    460       dims4(1) = idim_rlonv
    461       dims4(2) = idim_rlatu
    462       dims4(3) = idim_s
    463       dims4(4) = idim_tim
    464 cIM 220306 BEG
    465 #ifdef NC_DOUBLE
    466       ierr = NF_DEF_VAR (nid,"teta",NF_DOUBLE,4,dims4,nvarid)
    467 #else
    468       ierr = NF_DEF_VAR (nid,"teta",NF_FLOAT,4,dims4,nvarid)
    469 #endif
    470 cIM 220306 END
    471       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 11,
    472      .                       "Temperature")
    473 c
    474       dims4(1) = idim_rlonv
    475       dims4(2) = idim_rlatu
    476       dims4(3) = idim_s
    477       dims4(4) = idim_tim
    478 
    479       DO iq=1,nqtot
    480 cIM 220306 BEG
    481 #ifdef NC_DOUBLE
    482       ierr = NF_DEF_VAR (nid,tname(iq),NF_DOUBLE,4,dims4,nvarid)
    483 #else
    484       ierr = NF_DEF_VAR (nid,tname(iq),NF_FLOAT,4,dims4,nvarid)
    485 #endif
    486 cIM 220306 END
    487       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,ttext(iq))
    488       ENDDO
    489 c
    490       dims4(1) = idim_rlonv
    491       dims4(2) = idim_rlatu
    492       dims4(3) = idim_s
    493       dims4(4) = idim_tim
    494 cIM 220306 BEG
    495 #ifdef NC_DOUBLE
    496       ierr = NF_DEF_VAR (nid,"masse",NF_DOUBLE,4,dims4,nvarid)
    497 #else
    498       ierr = NF_DEF_VAR (nid,"masse",NF_FLOAT,4,dims4,nvarid)
    499 #endif
    500 cIM 220306 END
    501       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 12,
    502      .                       "C est quoi ?")
    503 c
    504       dims3(1) = idim_rlonv
    505       dims3(2) = idim_rlatu
    506       dims3(3) = idim_tim
    507 cIM 220306 BEG
    508 #ifdef NC_DOUBLE
    509       ierr = NF_DEF_VAR (nid,"ps",NF_DOUBLE,3,dims3,nvarid)
    510 #else
    511       ierr = NF_DEF_VAR (nid,"ps",NF_FLOAT,3,dims3,nvarid)
    512 #endif
    513 cIM 220306 END
    514       ierr = NF_PUT_ATT_TEXT (nid, nvarid, "title", 15,
    515      .                       "Pression au sol")
    516 c
    517       ierr = NF_ENDDEF(nid) ! sortir du mode de definition
    518       ierr = NF_CLOSE(nid) ! fermer le fichier
    519 
    520       write(lunout,*)'dynredem_loc: iim,jjm,llm,iday_end',
    521      &               iim,jjm,llm,iday_end
    522       write(lunout,*)'dynredem_loc: rad,omeg,g,cpp,kappa',
    523      &        rad,omeg,g,cpp,kappa
    524 
    525       endif  ! mpi_rank==0
    526       RETURN
    527       END
    528       SUBROUTINE dynredem1_loc(fichnom,time,
    529      .                     vcov,ucov,teta,q,masse,ps)
    530       USE parallel_lmdz
    531       USE mod_hallo
    532       USE infotrac
    533       USE control_mod
    534       USE dynredem_mod
    535       IMPLICIT NONE
    536 c=================================================================
    537 c  Ecriture du fichier de redemarrage sous format NetCDF
    538 c=================================================================
    539 #include "dimensions.h"
    540 #include "paramet.h"
    541 #include "description.h"
    542 #include "netcdf.inc"
    543 #include "comvert.h"
    544 #include "comgeom.h"
    545 #include "temps.h"
    546 #include "iniprint.h"
    547 
    548       INTEGER l
    549       REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    550       REAL teta(ijb_u:ije_u,llm)                   
    551       REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
    552       REAL q(ijb_u:ije_u,llm,nqtot)
    553       CHARACTER*(*) fichnom
    554      
    555       REAL time
    556       INTEGER nid, nvarid, nid_trac, nvarid_trac
    557       REAL trac_tmp(ijb_u:ije_u,llm)     
    558       INTEGER ierr, ierr_file
    559       INTEGER iq
    560       INTEGER length
    561       PARAMETER (length = 100)
    562       REAL tab_cntrl(length) ! tableau des parametres du run
    563       character*20 modname
    564       character*80 abort_message
    565 c
    566       INTEGER nb
    567       SAVE nb
    568       DATA nb / 0 /
    569       REAL,SAVE,ALLOCATABLE :: ucov_glo(:,:),vcov_glo(:,:),teta_glo(:,:)
    570       REAL,SAVE,ALLOCATABLE :: masse_glo(:,:),ps_glo(:),q_glo(:,:)
    571       LOGICAL,SAVE :: exist_file
    572       INTEGER,SAVE :: ierr_var
    573      
    574 !      call Gather_Field(ucov,ip1jmp1,llm,0)
    575 !      call Gather_Field(vcov,ip1jm,llm,0)
    576 !      call Gather_Field(teta,ip1jmp1,llm,0)
    577 !      call Gather_Field(masse,ip1jmp1,llm,0)
    578 !      call Gather_Field(ps,ip1jmp1,1,0)
    579      
    580 !      do iq=1,nqtot
    581 !        call Gather_Field(q(1,1,iq),ip1jmp1,llm,0)
    582  !     enddo
    583      
     55  yyears0=0
     56  mmois0=1
     57  jjour0=1
     58#endif       
     59
     60  tab_cntrl(:)  = 0.
     61  tab_cntrl(1)  = REAL(iim)
     62  tab_cntrl(2)  = REAL(jjm)
     63  tab_cntrl(3)  = REAL(llm)
     64  tab_cntrl(4)  = REAL(day_ref)
     65  tab_cntrl(5)  = REAL(annee_ref)
     66  tab_cntrl(6)  = rad
     67  tab_cntrl(7)  = omeg
     68  tab_cntrl(8)  = g
     69  tab_cntrl(9)  = cpp
     70  tab_cntrl(10) = kappa
     71  tab_cntrl(11) = daysec
     72  tab_cntrl(12) = dtvr
     73  tab_cntrl(13) = etot0
     74  tab_cntrl(14) = ptot0
     75  tab_cntrl(15) = ztot0
     76  tab_cntrl(16) = stot0
     77  tab_cntrl(17) = ang0
     78  tab_cntrl(18) = pa
     79  tab_cntrl(19) = preff
     80
     81!    .....    parameters for zoom    ......   
     82  tab_cntrl(20) = clon
     83  tab_cntrl(21) = clat
     84  tab_cntrl(22) = grossismx
     85  tab_cntrl(23) = grossismy
     86!
     87  IF ( fxyhypb )   THEN
     88    tab_cntrl(24) = 1.
     89    tab_cntrl(25) = dzoomx
     90    tab_cntrl(26) = dzoomy
     91    tab_cntrl(27) = 0.
     92    tab_cntrl(28) = taux
     93    tab_cntrl(29) = tauy
     94  ELSE
     95    tab_cntrl(24) = 0.
     96    tab_cntrl(25) = dzoomx
     97    tab_cntrl(26) = dzoomy
     98    tab_cntrl(27) = 0.
     99    tab_cntrl(28) = 0.
     100    tab_cntrl(29) = 0.
     101    IF( ysinus )  tab_cntrl(27) = 1.
     102  END IF
     103  tab_cntrl(30) = REAL(iday_end)
     104  tab_cntrl(31) = REAL(itau_dyn + itaufin)
     105! start_time: start_time of simulation (not necessarily 0.)
     106  tab_cntrl(32) = start_time
     107
     108!--- File creation
     109  CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
     110
     111!--- Some global attributes
     112  CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
     113
     114!--- Dimensions
     115  CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
     116  CALL err(NF90_DEF_DIM(nid,"rlonu", iip1,   rlonuID))
     117  CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1,   rlatuID))
     118  CALL err(NF90_DEF_DIM(nid,"rlonv", iip1,   rlonvID))
     119  CALL err(NF90_DEF_DIM(nid,"rlatv", jjm,    rlatvID))
     120  CALL err(NF90_DEF_DIM(nid,"sigs",  llm,        sID))
     121  CALL err(NF90_DEF_DIM(nid,"sig",   llmp1,    sigID))
     122  CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
     123
     124!--- Define and save invariant fields
     125  CALL put_var(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
     126  CALL put_var(nid,"rlonu"   ,"Longitudes des points U",[rlonuID],rlonu)
     127  CALL put_var(nid,"rlatu"   ,"Latitudes des points U" ,[rlatuID],rlatu)
     128  CALL put_var(nid,"rlonv"   ,"Longitudes des points V",[rlonvID],rlonv)
     129  CALL put_var(nid,"rlatv"   ,"Latitudes des points V" ,[rlatvID],rlatv)
     130  CALL put_var(nid,"nivsigs" ,"Numero naturel des couches s"    ,[sID]  ,nivsigs)
     131  CALL put_var(nid,"nivsig"  ,"Numero naturel des couches sigma",[sigID],nivsig)
     132  CALL put_var(nid,"ap"      ,"Coefficient A pour hybride"      ,[sigID],ap)
     133  CALL put_var(nid,"bp"      ,"Coefficient B pour hybride"      ,[sigID],bp)
     134  CALL put_var(nid,"presnivs",""                                ,[sID]  ,presnivs)
     135! covariant <-> contravariant <-> natural conversion coefficients
     136  CALL put_var(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
     137  CALL put_var(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
     138  CALL put_var(nid,"aire","Aires de chaque maille"     ,[rlonvID,rlatuID],aire)
     139  CALL put_var(nid,"phisinit","Geopotentiel au sol"    ,[rlonvID,rlatuID],phis_glo)
     140
     141!--- Define fields saved later
     142  WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')"),&
     143               yyears0,mmois0,jjour0
     144  CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
     145  CALL cre_var(nid,"ucov" ,"Vitesse U"  ,[rlonuID,rlatuID,sID,timID])
     146  CALL cre_var(nid,"vcov" ,"Vitesse V"  ,[rlonvID,rlatvID,sID,timID])
     147  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
     148  DO iq=1,nqtot
     149    CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
     150  END DO
     151  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])
     152  CALL cre_var(nid,"ps"   ,"Pression au sol",[rlonvID,rlatuID    ,timID])
     153  CALL err(NF90_CLOSE (nid))
     154
     155  WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
     156  WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
     157
     158END SUBROUTINE dynredem0_loc
     159!
     160!-------------------------------------------------------------------------------
     161
     162
     163!-------------------------------------------------------------------------------
     164!
     165SUBROUTINE dynredem1_loc(fichnom,time,vcov,ucov,teta,q,masse,ps)
     166!
     167!-------------------------------------------------------------------------------
     168! Purpose: Write the NetCDF restart file (append).
     169!-------------------------------------------------------------------------------
     170  USE parallel_lmdz
     171  USE mod_hallo
     172  USE infotrac
     173  USE control_mod
     174  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
     175                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
     176  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
     177                          err, modname, fil, msg
     178  IMPLICIT NONE
     179  include "dimensions.h"
     180  include "paramet.h"
     181  include "description.h"
     182  include "comvert.h"
     183  include "comgeom.h"
     184  include "temps.h"
     185  include "iniprint.h"
     186!===============================================================================
     187! Arguments:
     188  CHARACTER(LEN=*), INTENT(IN) :: fichnom              !-- FILE NAME
     189  REAL, INTENT(IN)    ::  time                         !-- TIME
     190  REAL, INTENT(IN)    ::  vcov(ijb_v:ije_v,llm)        !-- V COVARIANT WIND
     191  REAL, INTENT(IN)    ::  ucov(ijb_u:ije_u,llm)        !-- U COVARIANT WIND
     192  REAL, INTENT(IN)    ::  teta(ijb_u:ije_u,llm)        !-- POTENTIAL TEMPERATURE
     193  REAL, INTENT(INOUT) ::     q(ijb_u:ije_u,llm,nqtot)  !-- TRACERS
     194  REAL, INTENT(IN)    :: masse(ijb_u:ije_u,llm)        !-- MASS PER CELL
     195  REAL, INTENT(IN)    ::    ps(ijb_u:ije_u)            !-- GROUND PRESSURE
     196!===============================================================================
     197! Local variables:
     198  INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
     199  INTEGER, SAVE :: nb=0
     200  INTEGER, PARAMETER :: length=100
     201  REAL               :: tab_cntrl(length) ! tableau des parametres du run
     202  CHARACTER(LEN=256) :: var, dum
     203  LOGICAL            :: lread_inca
     204!===============================================================================
     205
     206!$OMP MASTER
     207  IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     208  modname='dynredem1_loc'; fil=fichnom
     209  fil=fichnom
     210  CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
     211
     212!--- Write/extend time coordinate
     213  nb = nb + 1
     214  var="temps"
     215  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
     216  CALL err(NF90_PUT_VAR(nid,vID,[time]),"put",var)
     217  WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
     218
     219!--- Rewrite control table (itaufin undefined in dynredem0)
     220  var="controle"
     221  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
     222  CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
     223  tab_cntrl(31)=DBLE(itau_dyn + itaufin)
     224  CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
     225  CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
     226  END IF               !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     227!$OMP END MASTER
     228
     229!--- Save fields
     230  CALL dynredem_write_u(nid,"ucov" ,ucov ,llm)
     231  CALL dynredem_write_v(nid,"vcov" ,vcov ,llm)
     232  CALL dynredem_write_u(nid,"teta" ,teta ,llm)
     233  CALL dynredem_write_u(nid,"masse",masse,llm)
     234  CALL dynredem_write_u(nid,"ps"   ,ps   ,1)
     235
     236!--- Tracers in file "start_trac.nc" (added by Anne)
     237!$OMP MASTER
     238  lread_inca=.FALSE.; fil="start_trac.nc"
     239  IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
     240  IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
     241!$OMP END MASTER
     242!$OMP BARRIER
     243
     244!--- Save tracers
     245  DO iq=1,nqtot; var=tname(iq); ierr=-1
     246    IF(lread_inca) THEN                  !--- Possibly read from "start_trac.nc"
    584247!$OMP MASTER     
    585       if (mpi_rank==0) then
    586       modname = 'dynredem1_loc'
    587       ierr = NF_OPEN(fichnom, NF_WRITE, nid)
    588       IF (ierr .NE. NF_NOERR) THEN
    589          write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
    590          CALL abort_gcm("dynredem1", "", 1)
    591       ENDIF
    592 
    593 c  Ecriture/extension de la coordonnee temps
    594 
    595       nb = nb + 1
    596       ierr = NF_INQ_VARID(nid, "temps", nvarid)
    597       IF (ierr .NE. NF_NOERR) THEN
    598          write(lunout,*) NF_STRERROR(ierr)
    599          abort_message='Variable temps n est pas definie'
    600          CALL abort_gcm(modname,abort_message,ierr)
    601       ENDIF
    602 #ifdef NC_DOUBLE
    603       ierr = NF_PUT_VAR1_DOUBLE (nid,nvarid,nb,time)
    604 #else
    605       ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
    606 #endif
    607       write(lunout,*) "dynredem1_loc: Enregistrement pour ", nb, time
    608 
    609 c
    610 c  Re-ecriture du tableau de controle, itaufin n'est plus defini quand
    611 c  on passe dans dynredem0
    612       ierr = NF_INQ_VARID (nid, "controle", nvarid)
    613       IF (ierr .NE. NF_NOERR) THEN
    614          abort_message="dynredem1: Le champ <controle> est absent"
    615          ierr = 1
    616          CALL abort_gcm(modname,abort_message,ierr)
    617       ENDIF
    618 #ifdef NC_DOUBLE
    619       ierr = NF_GET_VAR_DOUBLE(nid, nvarid, tab_cntrl)
    620 #else
    621       ierr = NF_GET_VAR_REAL(nid, nvarid, tab_cntrl)
    622 #endif
    623        tab_cntrl(31) =  REAL(itau_dyn + itaufin)
    624 #ifdef NC_DOUBLE
    625       ierr = NF_PUT_VAR_DOUBLE (nid,nvarid,tab_cntrl)
    626 #else
    627       ierr = NF_PUT_VAR_REAL (nid,nvarid,tab_cntrl)
    628 #endif
    629       endif
    630 !$OMP END MASTER
    631 
    632 !     
    633       CALL dynredem_write_u(nid,"ucov",ucov,llm)
    634       CALL dynredem_write_v(nid,"vcov",vcov,llm)
    635       CALL dynredem_write_u(nid,"teta",teta,llm)
    636       CALL dynredem_write_u(nid,"masse",masse,llm)
    637       CALL dynredem_write_u(nid,"ps",ps,1)
    638 
    639       IF (type_trac /= 'inca') THEN
    640         DO iq=1,nqtot
    641           CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)
    642         ENDDO
    643       ELSE
    644        
     248      fil="start_trac.nc"
     249      ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
     250      dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
     251      WRITE(lunout,*)msg(dum,var)
     252!$OMP END MASTER
     253!$OMP BARRIER
     254      IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,iq),llm)
     255    END IF
     256    fil=fichnom
     257    CALL dynredem_write_u(nid,var,q(:,:,iq),llm)
     258  END DO
     259
    645260!$OMP MASTER
    646         INQUIRE(FILE="start_trac.nc", EXIST=exist_file)
    647         PRINT *, "EXIST", exist_file
    648 !$OMP END MASTER
    649 !$OMP BARRIER
    650      
    651         IF (exist_file) THEN
    652 !$OMP MASTER
    653           ierr_file = NF_OPEN ("start_trac.nc", NF_NOWRITE,nid_trac)
    654           IF (ierr_file .NE.NF_NOERR) THEN
    655             WRITE(6,*)' Pb d''ouverture du fichier start_trac.nc'
    656             WRITE(6,*)' ierr = ', ierr_file
    657           ENDIF
    658 !$OMP END MASTER
    659 
    660           DO iq=1,nqtot
    661 
    662 !$OMP MASTER     
    663             ierr_var = NF_INQ_VARID (nid_trac, tname(iq), nvarid_trac)
    664 !$OMP END MASTER
    665 !$OMP BARRIER
    666             IF (ierr == NF_NOERR) THEN
    667               CALL dynredem_read_u(nid_trac,tname(iq),q(:,:,iq),llm)
    668             ENDIF
    669             CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm) 
    670           ENDDO         
    671          
    672         ELSE ! pas de fichier start_tract
    673           DO iq=1,nqtot
    674             CALL dynredem_write_u(nid,tname(iq),q(:,:,iq),llm)
    675           ENDDO
    676         ENDIF
    677       ENDIF
    678 
    679 
    680 !$OMP MASTER
    681       IF (mpi_rank==0) THEN
    682         ierr = NF_CLOSE(nid)
    683       ENDIF ! mpi_rank==0
    684 !$OMP END MASTER
    685      
    686       RETURN
    687       END
    688 
     261  IF(mpi_rank==0) THEN !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     262  CALL err(NF90_CLOSE(nid),"close")
     263  fil="start_trac.nc"
     264  IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
     265  END IF               !++++++++++++++++++++++++++++++++++++++++++++++++++++++++
     266!$OMP END MASTER
     267
     268END SUBROUTINE dynredem1_loc
     269

  • LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90

    r1907 r2299  
    1 !
    2 ! $Id$
    3 !
    41MODULE dynredem_mod
    52
    6 CONTAINS
    7 
    8   SUBROUTINE dynredem_write_u(ncid,id,var,ll)
    93  USE dimensions_mod
    104  USE parallel_lmdz
    115  USE mod_hallo
    12   IMPLICIT NONE
    13     INTEGER          :: ncid
    14     CHARACTER(LEN=*) :: id
    15     REAL             :: var(ijb_u:ije_u,ll)
    16     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    17     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    18     INTEGER          :: ll
    19     INTEGER          :: count(4)
    20     INTEGER          :: start(4)
    21     INTEGER          :: l
    22     INTEGER          :: nvarid
    23     INTEGER          :: ierr
    24     INCLUDE 'netcdf.inc'   
     6  USE netcdf
     7  PRIVATE
     8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
     9  PUBLIC :: cre_var, get_var1, put_var, fil, modname, msg
     10  CHARACTER(LEN=256), SAVE :: fil, modname
     11  INTEGER,            SAVE :: nvarid
     12
     13
     14CONTAINS
     15
     16
     17!===============================================================================
     18!
     19SUBROUTINE dynredem_write_u(ncid,id,var,ll)
     20!
     21!===============================================================================
     22  IMPLICIT NONE
     23!===============================================================================
     24! Arguments:
     25  INTEGER,          INTENT(IN) :: ncid
     26  CHARACTER(LEN=*), INTENT(IN) :: id
     27  REAL,             INTENT(IN) :: var(ijb_u:ije_u,ll)
     28  INTEGER,          INTENT(IN) :: ll
     29!===============================================================================
     30! Local variables:
     31  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     32  INTEGER :: start(4), count(4), l, ierr
     33!===============================================================================
     34  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
     35
     36!$OMP MASTER
     37  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
     38!$OMP END MASTER
     39
     40!$OMP MASTER
     41  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
     42!$OMP END MASTER
     43!$OMP BARRIER
     44
     45!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     46  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
     47  DO l=1,ll
     48    CALL gather_field_u(var_tmp(:,l),var_glo,1)
     49    IF(mpi_rank==0) THEN
     50    !$OMP MASTER
     51      start(3)=l
     52      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
     53    !$OMP END MASTER
     54    END IF
     55  END DO
     56!$OMP BARRIER
     57!$OMP MASTER
     58  DEALLOCATE(var_glo,var_tmp)
     59!$OMP END MASTER
     60!$OMP BARRIER
     61 
     62END SUBROUTINE dynredem_write_u
     63!
     64!===============================================================================
     65
     66
     67!===============================================================================
     68!
     69SUBROUTINE dynredem_write_v(ncid,id,var,ll)
     70!
     71!===============================================================================
     72  IMPLICIT NONE
     73!===============================================================================
     74! Arguments:
     75  INTEGER,          INTENT(IN) :: ncid
     76  CHARACTER(LEN=*), INTENT(IN) :: id
     77  REAL,             INTENT(IN) :: var(ijb_v:ije_v,ll)
     78  INTEGER,          INTENT(IN) :: ll
     79!===============================================================================
     80! Local variables:
     81  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     82  INTEGER :: start(4), count(4), l, ierr
     83!===============================================================================
     84  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,1,1]
     85
     86!$OMP MASTER
     87  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
     88!$OMP END MASTER
     89
     90!$OMP MASTER
     91  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
     92!$OMP END MASTER
     93!$OMP BARRIER
     94
     95!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     96  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
     97  DO l=1,ll
     98    CALL gather_field_v(var_tmp(:,l),var_glo,1)
     99    IF(mpi_rank==0) THEN
     100    !$OMP MASTER
     101      start(3)=l
     102      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
     103    !$OMP END MASTER
     104    END IF
     105  END DO
     106!$OMP BARRIER
     107!$OMP MASTER
     108  DEALLOCATE(var_glo,var_tmp)
     109!$OMP END MASTER
     110!$OMP BARRIER
     111 
     112END SUBROUTINE dynredem_write_v
     113!
     114!===============================================================================
     115
     116
     117!===============================================================================
     118!
     119SUBROUTINE dynredem_read_u(ncid,id,var,ll)
     120!
     121!===============================================================================
     122  IMPLICIT NONE
     123!===============================================================================
     124! Arguments:
     125  INTEGER,          INTENT(IN)  :: ncid
     126  CHARACTER(LEN=*), INTENT(IN)  :: id
     127  REAL,             INTENT(OUT) :: var(ijb_u:ije_u,ll)
     128  INTEGER,          INTENT(IN)  :: ll
     129!===============================================================================
     130! Local variables:
     131  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
     132  INTEGER :: start(4), count(4), l, ierr
     133!===============================================================================
     134  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
     135
     136!$OMP MASTER
     137  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),'inq',id)
     138!$OMP END MASTER
     139
     140!$OMP MASTER
     141  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
     142!$OMP END MASTER
     143!$OMP BARRIER
     144
     145  DO l=1,ll
     146    IF(mpi_rank==0) THEN
     147    !$OMP MASTER
     148      start(3)=l
     149      CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id)
     150    !$OMP END MASTER
     151    END IF
     152    CALL scatter_field_u(var_glo,var_tmp(:,l),1)
     153  END DO
     154
     155!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     156  DO l=1,ll; var(:,l)=var_tmp(:,l); END DO
    25157   
    26     count(:)=(/ iip1,jjp1,1,1 /)
    27     start(:)=(/ 1,1,1,1 /)
    28    
    29 !$OMP MASTER   
    30    IF (mpi_rank==0) THEN
    31      ierr = NF_INQ_VARID(ncid, id, nvarid)
    32      IF (ierr .NE. NF_NOERR) THEN
    33        PRINT*, "Variable "//id//" n est pas definie"
    34        CALL abort
    35      ENDIF
    36    ENDIF
    37 !$OMP END MASTER
    38 
    39 !$OMP MASTER
    40     ALLOCATE(var_tmp(ijb_u:ije_u,ll))
    41     ALLOCATE(var_glo(ip1jmp1))
    42 !$OMP END MASTER
    43 !$OMP BARRIER
    44 
    45 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    46     DO l=1,ll
    47       var_tmp(:,l)=var(:,l)
    48     ENDDO
    49 
    50     DO l=1,ll
    51       CALL gather_field_u(var_tmp(:,l),var_glo,1)
    52        IF (mpi_rank==0) THEN
    53    !$OMP MASTER
    54         start(3)=l
     158!$OMP BARRIER
     159!$OMP MASTER
     160  DEALLOCATE(var_glo,var_tmp)
     161!$OMP END MASTER
     162!$OMP BARRIER
     163 
     164END SUBROUTINE dynredem_read_u   
     165!
     166!===============================================================================
     167
     168
     169!===============================================================================
     170!
     171SUBROUTINE cre_var(ncid,var,title,did,units)
     172!
     173!===============================================================================
     174  IMPLICIT NONE
     175!===============================================================================
     176! Arguments:
     177  INTEGER,                    INTENT(IN) :: ncid
     178  CHARACTER(LEN=*),           INTENT(IN) :: var, title
     179  INTEGER,                    INTENT(IN) :: did(:)
     180  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
     181!===============================================================================
    55182#ifdef NC_DOUBLE
    56         ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
     183  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
    57184#else
    58         ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
     185  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
    59186#endif
    60    !$OMP END MASTER
    61        ENDIF
    62     ENDDO
    63    
    64   !$OMP BARRIER
    65   !$OMP MASTER
    66     DEALLOCATE(var_tmp)
    67     DEALLOCATE(var_glo)
    68   !$OMP END MASTER
    69   !$OMP BARRIER
    70  
    71   END SUBROUTINE dynredem_write_u
    72      
    73   SUBROUTINE dynredem_write_v(ncid,id,var,ll)
    74   USE dimensions_mod
    75   USE parallel_lmdz
    76   USE mod_hallo
    77   IMPLICIT NONE
    78     INTEGER          :: ncid
    79     CHARACTER(LEN=*) :: id
    80     REAL             :: var(ijb_v:ije_v,ll)
    81     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    82     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    83     INTEGER          :: ll
    84     INTEGER          :: count(4)
    85     INTEGER          :: start(4)
    86     INTEGER          :: l
    87     INTEGER          :: nvarid
    88     INTEGER          :: ierr
    89     INCLUDE 'netcdf.inc'   
    90    
    91     count(:)=(/ iip1,jjm,1,1 /)
    92     start(:)=(/ 1,1,1,1 /)
    93    
    94 !$OMP MASTER   
    95    IF (mpi_rank==0) THEN
    96      ierr = NF_INQ_VARID(ncid, id, nvarid)
    97      IF (ierr .NE. NF_NOERR) THEN
    98        PRINT*, "Variable "//id//" n est pas definie"
    99        CALL abort
    100      ENDIF
    101    ENDIF
    102 !$OMP END MASTER
    103  
    104 !$OMP MASTER
    105     ALLOCATE(var_tmp(ijb_v:ije_v,ll))
    106     ALLOCATE(var_glo(ip1jm))
    107 !$OMP END MASTER
    108 !$OMP BARRIER
    109 
    110 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    111     DO l=1,ll
    112       var_tmp(:,l)=var(:,l)
    113     ENDDO
    114 
    115     DO l=1,ll
    116       CALL gather_field_v(var_tmp(:,l),var_glo,1)
    117        IF (mpi_rank==0) THEN
    118    !$OMP MASTER
    119         start(3)=l
    120 #ifdef NC_DOUBLE
    121         ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
    122 #else
    123         ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
    124 #endif
    125    !$OMP END MASTER
    126        ENDIF
    127     ENDDO
    128    
    129   !$OMP BARRIER
    130   !$OMP MASTER
    131     DEALLOCATE(var_tmp)
    132     DEALLOCATE(var_glo)
    133   !$OMP END MASTER
    134   !$OMP BARRIER
    135  
    136   END SUBROUTINE dynredem_write_v
    137 
    138   SUBROUTINE dynredem_read_u(ncid,id,var,ll)
    139   USE dimensions_mod
    140   USE parallel_lmdz
    141   USE mod_hallo
    142   IMPLICIT NONE
    143     INTEGER          :: ncid
    144     CHARACTER(LEN=*) :: id
    145     REAL             :: var(ijb_u:ije_u,ll)
    146     REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
    147     REAL,ALLOCATABLE,SAVE  :: var_glo(:)
    148     INTEGER          :: ll
    149     INTEGER          :: count(4)
    150     INTEGER          :: start(4)
    151     INTEGER          :: l
    152     INTEGER          :: nvarid
    153     INTEGER          :: ierr
    154     INCLUDE 'netcdf.inc'   
    155    
    156     count(:)=(/ iip1,jjp1,1,1 /)
    157     start(:)=(/ 1,1,1,1 /)
    158    
    159 !$OMP MASTER   
    160    IF (mpi_rank==0) THEN
    161      ierr = NF_INQ_VARID(ncid, id, nvarid)
    162      IF (ierr .NE. NF_NOERR) THEN
    163        PRINT*, "Variable "//id//" n est pas definie"
    164        CALL abort
    165      ENDIF
    166    ENDIF
    167 !$OMP END MASTER
    168  
    169 !$OMP MASTER
    170     ALLOCATE(var_tmp(ijb_u:ije_u,ll))
    171     ALLOCATE(var_glo(ip1jmp1))
    172 !$OMP END MASTER
    173 !$OMP BARRIER
    174 
    175 
    176     DO l=1,ll
    177        IF (mpi_rank==0) THEN
    178    !$OMP MASTER
    179         start(3)=l
    180 #ifdef NC_DOUBLE
    181         ierr = NF_GET_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
    182 #else
    183         ierr = NF_GET_VARA_REAL (ncid,nvarid,start,count,var_glo)
    184 #endif
    185    !$OMP END MASTER
    186        ENDIF
    187        CALL scatter_field_u(var_glo,var_tmp(:,l),1)
    188     ENDDO
    189 
    190 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    191     DO l=1,ll
    192       var(:,l)=var_tmp(:,l)
    193     ENDDO
    194    
    195   !$OMP BARRIER
    196   !$OMP MASTER
    197     DEALLOCATE(var_tmp)
    198     DEALLOCATE(var_glo)
    199   !$OMP END MASTER
    200   !$OMP BARRIER
    201  
    202   END SUBROUTINE dynredem_read_u   
    203  
     187  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
     188  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
     189
     190END SUBROUTINE cre_var
     191!
     192!===============================================================================
     193
     194
     195!===============================================================================
     196!
     197SUBROUTINE put_var(ncid,var,title,did,v,units)
     198!
     199!===============================================================================
     200  IMPLICIT NONE
     201!===============================================================================
     202! Arguments:
     203  INTEGER,                    INTENT(IN) :: ncid
     204  CHARACTER(LEN=*),           INTENT(IN) :: var, title
     205  INTEGER,                    INTENT(IN) :: did(:)
     206  REAL,                       INTENT(IN) :: v(:)
     207  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
     208!===============================================================================
     209  INTEGER :: nd, k, nn(2)
     210  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
     211  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
     212  CALL err(NF90_ENDDEF(ncid))
     213  nd=SIZE(did)
     214  DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
     215  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
     216  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
     217  CALL err(NF90_REDEF(ncid))
     218END SUBROUTINE put_var
     219!
     220!===============================================================================
     221
     222
     223!===============================================================================
     224!
     225FUNCTION msg(typ,nam)
     226!
     227!===============================================================================
     228  IMPLICIT NONE
     229!===============================================================================
     230! Arguments:
     231  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
     232  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
     233  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
     234!===============================================================================
     235  SELECT CASE(typ)
     236    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
     237    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
     238    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
     239    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
     240    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
     241    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
     242  END SELECT
     243  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
     244
     245END FUNCTION msg
     246!
     247!===============================================================================
     248
     249
     250!===============================================================================
     251!
     252SUBROUTINE err(ierr,typ,nam)
     253!
     254!===============================================================================
     255  IMPLICIT NONE
     256!===============================================================================
     257! Arguments:
     258  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
     259  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
     260  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
     261!===============================================================================
     262  IF(ierr==NF90_NoERR) RETURN
     263  IF(.NOT.PRESENT(typ)) THEN
     264    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
     265  ELSE
     266    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
     267  END IF
     268
     269END SUBROUTINE err
     270!
     271!===============================================================================
     272
    204273END MODULE dynredem_mod   
     274
    205275   
    206276   

  • LMDZ5/trunk/libf/dynlonlat_phylonlat/grid_atob_m.f90

    r2298 r2299  
    2121!-------------------------------------------------------------------------------
    2222! Arguments:
    23   REAL,                       INTENT(IN)  :: x_i(:), y_i(:)  !- IN  X&Y COORD.
    24   REAL,                       INTENT(IN)  :: x_o(:), y_o(:)  !- OUT X&Y COORD.
    25   DOUBLE PRECISION,           INTENT(OUT) :: d_o1(:,:)       !- OUT FLD (mo,no)
    26   REAL,             OPTIONAL, INTENT(IN)  :: d_i (:,:)       !- INP FLD (mi,ni)
    27   LOGICAL,          OPTIONAL, INTENT(IN)  :: msk (:,:)       !- MASK    (mi,ni)
    28   DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: d_o2(:,:)       !- OUT FOR d_i^2
     23  REAL,              INTENT(IN)  :: x_i(:), y_i(:) !-- INPUT  X&Y COOR. (mi)(ni)
     24  REAL,              INTENT(IN)  :: x_o(:), y_o(:) !-- OUTPUT X&Y COOR. (mi)(ni)
     25  REAL,              INTENT(OUT) :: d_o1(:,:)      !-- OUTPUT FIELD    (mo,no)
     26  REAL,    OPTIONAL, INTENT(IN)  :: d_i (:,:)      !-- INPUT FIELD      (mi,ni)
     27  LOGICAL, OPTIONAL, INTENT(IN)  :: msk (:,:)      !-- MASK             (mi,ni)
     28  REAL,    OPTIONAL, INTENT(OUT) :: d_o2(:,:)      !-- OUTPUT FOR d_i^2 (mo,no)
    2929!-------------------------------------------------------------------------------
    3030! Local variables:
    3131  CHARACTER(LEN=256) :: modname="fine2coarse"
    32   DOUBLE PRECISION   :: inc
    3332  INTEGER :: mi, ni, ii, ji, mo, no, io, jo, nr(2), m1, n1, m2, n2, nn
    3433  INTEGER :: num_tot(SIZE(x_o),SIZE(y_o))
    … …  
    3635  LOGICAL :: mask (SIZE(x_i),SIZE(y_i)), lo
    3736  REAL    :: dist (SIZE(x_o),SIZE(y_o))
    38   REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o))
     37  REAL    :: a(SIZE(x_o)), b(SIZE(x_o)), c(SIZE(y_o)), d(SIZE(y_o)), inc
    3938  REAL, PARAMETER :: thresh=1.E-5
    4039!-------------------------------------------------------------------------------
    … …  
    5655
    5756!--- ACCUMULATE INPUT POINTS ON OUTPUT GRID
    58   d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0d0
     57  d_o1(:,:)=0.; num_tot(:,:)=0; inc=1.0
    5958  IF(lo) d_o2(:,:)=0.
    6059  DO ji = 1, ni
    6160    DO ii = 1, mi
    62       IF(li) inc=DBLE(d_i(ii,ji))
     61      IF(li) inc=d_i(ii,ji)
    6362      DO jo = 1, no
    6463        IF((y_i(ji)-c(jo)<thresh.OR.y_i(ji)-d(jo)>thresh).AND.   &
    … …  
    7877!--- CHECK INPUT POINTS HAVE BEEN FOUND IN EACH OUTPUT CELL
    7978  found(:,:)=num_tot(:,:)/=0
    80   WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/DBLE(num_tot(:,:))
     79  WHERE(found.AND.mask) d_o1(:,:)=d_o1(:,:)/REAL(num_tot(:,:))
    8180  IF(PRESENT(d_o2)) THEN
    82     WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/DBLE(num_tot(:,:))
     81    WHERE(found.AND.mask) d_o2(:,:)=d_o2(:,:)/REAL(num_tot(:,:))
    8382    RETURN
    8483  END IF
    … …  
    9291      CALL dist_sphe(x_o(io),y_o(jo),x_i,y_i,dist(:,:))
    9392      nr=MINLOC(dist(:,:))!; IF(prt_level>=1) PRINT*, "Solution: ", nr
    94       inc=1.0; IF(li) inc=DBLE(d_i(nr(1),nr(2)))
     93      inc=1.0; IF(li) inc=d_i(nr(1),nr(2))
    9594      IF(mask(nr(1),nr(2))) d_o1(io,jo)=inc
    9695    END DO
    … …  
    133132  REAL, INTENT(OUT) :: sortie(SIZE(x),SIZE(y))  !--- OUTPUT FIELD
    134133!-------------------------------------------------------------------------------
    135 ! Local variable:
    136   DOUBLE PRECISION  :: out(SIZE(x),SIZE(y))
    137 !-------------------------------------------------------------------------------
    138 !  CALL fine2coarse(xdata,ydata,x,y,out,DBLE(entree))
    139   CALL fine2coarse(xdata,ydata,x,y,out,entree)
    140   sortie=REAL(out)
     134  CALL fine2coarse(xdata,ydata,x,y,sortie,entree)
    141135
    142136END SUBROUTINE grille_m
    … …  
    152146! Author:  Z.X. Li (april 1st 1994)
    153147!-------------------------------------------------------------------------------
    154 ! Purpose: From topography field, compute ocean/land mask (land: 1 ; ocean: 0)
     148! Purpose: Remap rugosity length ; constant value (0.001) on oceans.
    155149! Naive method  (see grille_m)
    156150!-------------------------------------------------------------------------------
    … …  
    164158  REAL, INTENT(IN)  :: mask  (SIZE(x),SIZE(y)) !--- MASK
    165159!-------------------------------------------------------------------------------
    166 ! Local variable:
    167   DOUBLE PRECISION  :: out   (SIZE(x),SIZE(y))
    168 !-------------------------------------------------------------------------------
    169   CALL fine2coarse(xdata,ydata,x,y,out,LOG(entree))
     160  CALL fine2coarse(xdata,ydata,x,y,sortie,LOG(entree))
    170161  WHERE(NINT(mask)==1)
    171     out(:,:)=EXP(out(:,:))
     162    sortie(:,:)=EXP(sortie(:,:))
    172163  ELSE WHERE
    173     out(:,:)=0.001
     164    sortie(:,:)=0.001
    174165  END WHERE
    175   sortie=REAL(out)
    176166
    177167END SUBROUTINE rugosite
    … …  
    198188  REAL, INTENT(OUT) :: frac_ice(SIZE(x),SIZE(y)) !--- OUTPUT FIELD
    199189!-------------------------------------------------------------------------------
    200 ! Local variable:
    201   DOUBLE PRECISION  :: out     (SIZE(x),SIZE(y))
    202 !-------------------------------------------------------------------------------
    203   CALL fine2coarse(xdata,ydata,x,y,out,msk=NINT(glace01)==1)
    204   frac_ice=REAL(out)
     190  CALL fine2coarse(xdata,ydata,x,y,frac_ice,msk=NINT(glace01)==1)
    205191
    206192END SUBROUTINE sea_ice
    … …  
    228214  INTEGER           :: k, nn
    229215  INTEGER, PARAMETER:: itmp=360, jtmp=180
    230   DOUBLE PRECISION  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
    231   DOUBLE PRECISION  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp)
    232   REAL              :: xtmp(itmp), ytmp(jtmp)
     216  REAL  :: out(SIZE(xmod),SIZE(xmod)), amin, amax
     217  REAL  :: cham1tmp(itmp,jtmp), cham2tmp(itmp,jtmp), xtmp(itmp), ytmp(jtmp)
    233218!-------------------------------------------------------------------------------
    234219
    … …  
    245230  nn=COUNT(cham2tmp<0)
    246231  IF(nn/=0) PRINT*,'Problem for rugsoro ; std**2 < 0. for several points: ',nn
    247   WHERE(cham2tmp<0.0) cham2tmp=0.0d0
     232  WHERE(cham2tmp<0.0) cham2tmp=0.0
    248233  cham2tmp(:,:)=SQRT(cham2tmp(:,:))
    249234  amin=MINVAL(cham2tmp); amax=MAXVAL(cham2tmp)
    … …  
    251236
    252237!--- COMPUTE RUGOSITY AT REQUIRED SCALE
    253   WHERE(cham2tmp<0.001d0) cham2tmp=0.001d0
     238  WHERE(cham2tmp<0.001) cham2tmp=0.001
    254239  CALL fine2coarse(xtmp,ytmp,xmod,ymod,out,REAL(LOG(cham2tmp)))
    255240  out=EXP(out)
    256241  amin=MINVAL(out); amax=MAXVAL(out)
    257242  PRINT*, 'Ecart-type du modele:', amin, amax
    258   out=out/amax*20.0d0
     243  out=out/amax*20.0
    259244  amin=MINVAL(out); amax=MAXVAL(out)
    260245  PRINT*, 'Longueur de rugosite du modele:', amin, amax

  • LMDZ5/trunk/libf/phylmd/etat0phys_netcdf.F90

    r2293 r2299  
    6262  REAL, SAVE :: deg2rad
    6363  REAL, SAVE, ALLOCATABLE :: tsol(:)
    64   REAL, SAVE, ALLOCATABLE :: rugo(:,:)  ! ??? COMPUTED BUT NOT USED ???
     64!  REAL, SAVE, ALLOCATABLE :: rugo(:,:)  ! ??? COMPUTED BUT NOT USED ???
    6565  INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
    6666  REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
    … …  
    8686  USE fonte_neige_mod
    8787  USE pbl_surface_mod
    88   USE filtreg_mod
    8988  USE regr_lat_time_climoz_m, ONLY: regr_lat_time_climoz
    9089  USE indice_sol_mod
    … …  
    335334!===============================================================================
    336335  USE conf_dat_m,  ONLY: conf_dat2d
    337   USE grid_atob_m, ONLY: rugsoro
     336!  USE grid_atob_m, ONLY: rugsoro
    338337  USE grid_noro_m, ONLY: grid_noro
    339338  IMPLICIT NONE
    … …  
    393392
    394393!--- COMPUTE SURFACE ROUGHNESS
    395   WRITE(lunout,*)
    396   WRITE(lunout,*)'*** Compute surface roughness induced by the orography ***'
    397   ALLOCATE(tmp_var(iml-1,jml))
    398   CALL rugsoro(lon_rad, lat_rad, relief_hi, lon_in(1:iml-1), lat_in, tmp_var)
    399   ALLOCATE(rugo(iml,jml)); rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
    400   DEALLOCATE(relief_hi,tmp_var,lon_rad,lat_rad)
     394!  WRITE(lunout,*)
     395!  WRITE(lunout,*)'*** Compute surface roughness induced by the orography ***'
     396!  ALLOCATE(tmp_var(iml-1,jml))
     397!  CALL rugsoro(lon_rad, lat_rad, relief_hi, lon_in(1:iml-1), lat_in, tmp_var)
     398!  ALLOCATE(rugo(iml,jml)); rugo(1:iml-1,:)=tmp_var; rugo(iml,:)=tmp_var(1,:)
     399!  DEALLOCATE(tmp_var)
     400  DEALLOCATE(relief_hi,lon_rad,lat_rad)
    401401
    402402!--- PUT QUANTITIES TO PHYSICAL GRID

  • LMDZ5/trunk/libf/phylmd/phyredem.F90

    r2293 r2299  
    132132    PRINT*, "Trop de sous-surfaces"; CALL abort_gcm("phyredem", "", 1)
    133133  END IF
     134  IF(nsw>99) THEN
     135    PRINT*, "Trop de bandes"; CALL abort_gcm("phyredem", "", 1)
     136  END IF
    134137
    135138  CALL put_field_srf1("TS","Temperature",ftsol(:,:))
    … …  
    149152  CALL put_field_srf1("EVAP", "Evaporation", fevap(:,:))
    150153
    151   CALL put_field_srf1("SNOW", "Neige", fevap(:,:))
     154  CALL put_field_srf1("SNOW", "Neige", snow(:,:))
    152155
    153156  CALL put_field("RADS", "Rayonnement net a la surface", radsol)
    … …  
    302305  REAL,              INTENT(IN) :: field(:,:)
    303306  CHARACTER(LEN=256) :: nm, lm, str
    304   DO nsrf = 1, nbsrf
     307  DO nsrf = 1, SIZE(field,2)
    305308    WRITE(str, '(i2.2)') nsrf
    306309    nm=TRIM(nam)//TRIM(str)
    … …  
    318321  REAL,              INTENT(IN) :: field(:,:,:)
    319322  CHARACTER(LEN=256) :: nm, lm, str
    320   DO nsrf = 1, nbsrf
    321     DO isoil=1, nsw
     323  DO nsrf = 1, SIZE(field,3)
     324    DO isoil=1, SIZE(field,2)
    322325      WRITE(str, '(i2.2,"srf",i2.2)')isoil,nsrf
    323326!      WRITE(lunout,*)"PHYREDEM ",TRIM(nam)//TRIM(str)
    … …  
    337340  REAL,              INTENT(IN) :: field(:,:,:)
    338341  CHARACTER(LEN=256) :: nm, lm, str
    339   DO nsrf = 1, nbsrf
     342  DO nsrf = 1, SIZE(field,3)
    340343    WRITE(str, '(i2.2)') nsrf
    341344    nm=TRIM(nam)//TRIM(str)
Note: See TracChangeset for help on using the changeset viewer.