Ignore:
Timestamp:
Jul 19, 2024, 6:40:44 PM (12 months ago)
Author:
Laurent Fairhead
Message:

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF

Location:
LMDZ6/trunk/libf/phylmd/dyn1d
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/dyn1d/1DUTILS.h

    r5075 r5084  
    673673      USE logic_mod, ONLY: fxyhypb, ysinus
    674674      USE temps_mod, ONLY: annee_ref, day_ini, day_ref, itau_dyn
    675       USE lmdz_netcdf, ONLY:nf_open,nf_write,nf_noerr
    676675
    677676      IMPLICIT NONE
    … …  
    683682      include "dimensions.h"
    684683!!#include "control.h"
     684      include "netcdf.inc"
    685685
    686686!   Arguments:
    … …  
    820820      USE logic_mod, ONLY: fxyhypb, ysinus
    821821      USE temps_mod, ONLY: annee_ref,day_end,day_ref,itau_dyn,itaufin
    822       USE lmdz_netcdf, ONLY:nf_open,nf_write,nf_noerr
    823822
    824823      IMPLICIT NONE
    … …  
    830829      include "dimensions.h"
    831830!!#include "control.h"
     831      include "netcdf.inc"
    832832
    833833!   Arguments:

  • LMDZ6/trunk/libf/phylmd/dyn1d/1D_decl_cases.h

    r5075 r5084  
     1        INCLUDE "netcdf.inc"
    12
    23! Declarations specifiques au cas Toga

  • LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_amma_read.F90

    r5075 r5084  
    11MODULE mod_1D_amma_read
    2         USE lmdz_netcdf, ONLY: nf90_get_var,nf_open,nf_noerr,nf_open,nf_nowrite,&
    3                 nf_inq_dimid,nf_inq_dimlen,nf_strerror,nf_inq_varid
     2
    43!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    54!Declarations specifiques au cas AMMA
    … …  
    76! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
    87        integer nlev_amma, nt_amma
     8
    99
    1010        integer year_ini_amma, day_ini_amma, mth_ini_amma
    … …  
    5959      implicit none
    6060
     61      INCLUDE "netcdf.inc"
     62
    6163      INTEGER nid,rid,ierr
    6264
    … …  
    6567      ierr = NF_OPEN(fich_amma,NF_NOWRITE,nid)
    6668      print*,'fich_amma,NF_NOWRITE,nid ',fich_amma,NF_NOWRITE,nid
    67       if (ierr/=NF_NOERR) then
     69      if (ierr.NE.NF_NOERR) then
    6870         write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    6971         write(*,*) NF_STRERROR(ierr)
    … …  
    7274!.......................................................................
    7375      ierr=NF_INQ_DIMID(nid,'lev',rid)
    74       IF (ierr/=NF_NOERR) THEN
     76      IF (ierr.NE.NF_NOERR) THEN
    7577         print*, 'Oh probleme lecture dimension zz'
    7678      ENDIF
    … …  
    8183      print*,'nid,rid',nid,rid
    8284      nt_amma=0
    83       IF (ierr/=NF_NOERR) THEN
     85      IF (ierr.NE.NF_NOERR) THEN
    8486        stop 'probleme lecture dimension sens'
    8587      ENDIF
    … …  
    170172
    171173
     174END MODULE mod_1D_amma_read
    172175!=====================================================================
    173176      subroutine read_amma(nid,nlevel,ntime                          &
    … …  
    177180!program reading forcings of the AMMA case study
    178181      implicit none
     182      INCLUDE "netcdf.inc"
    179183
    180184      integer ntime,nlevel
    … …  
    264268!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
    265269 
    266          ierr = nf90_get_var(nid,var3didin(1),zz)
     270#ifdef NC_DOUBLE
     271         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
     272#else
     273         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
     274#endif
    267275         if(ierr/=NF_NOERR) then
    268276            write(*,*) NF_STRERROR(ierr)
    … …  
    271279!          write(*,*)'lecture z ok',zz
    272280
    273          ierr = nf90_get_var(nid,var3didin(2),temp)
     281#ifdef NC_DOUBLE
     282         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),temp)
     283#else
     284         ierr = NF_GET_VAR_REAL(nid,var3didin(2),temp)
     285#endif
    274286         if(ierr/=NF_NOERR) then
    275287            write(*,*) NF_STRERROR(ierr)
    … …  
    278290!          write(*,*)'lecture th ok',temp
    279291
    280          ierr = nf90_get_var(nid,var3didin(3),qv)
     292#ifdef NC_DOUBLE
     293         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),qv)
     294#else
     295         ierr = NF_GET_VAR_REAL(nid,var3didin(3),qv)
     296#endif
    281297         if(ierr/=NF_NOERR) then
    282298            write(*,*) NF_STRERROR(ierr)
    … …  
    285301!          write(*,*)'lecture qv ok',qv
    286302 
    287          ierr = nf90_get_var(nid,var3didin(4),u)
     303#ifdef NC_DOUBLE
     304         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),u)
     305#else
     306         ierr = NF_GET_VAR_REAL(nid,var3didin(4),u)
     307#endif
    288308         if(ierr/=NF_NOERR) then
    289309            write(*,*) NF_STRERROR(ierr)
    … …  
    292312!          write(*,*)'lecture u ok',u
    293313
    294          ierr = nf90_get_var(nid,var3didin(5),v)
     314#ifdef NC_DOUBLE
     315         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),v)
     316#else
     317         ierr = NF_GET_VAR_REAL(nid,var3didin(5),v)
     318#endif
    295319         if(ierr/=NF_NOERR) then
    296320            write(*,*) NF_STRERROR(ierr)
    … …  
    299323!          write(*,*)'lecture v ok',v
    300324
    301          ierr = nf90_get_var(nid,var3didin(6),dw)
     325#ifdef NC_DOUBLE
     326         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),dw)
     327#else
     328         ierr = NF_GET_VAR_REAL(nid,var3didin(6),dw)
     329#endif
    302330         if(ierr/=NF_NOERR) then
    303331            write(*,*) NF_STRERROR(ierr)
    … …  
    306334!          write(*,*)'lecture w ok',dw
    307335
    308          ierr = nf90_get_var(nid,var3didin(7),dt)
     336#ifdef NC_DOUBLE
     337         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),dt)
     338#else
     339         ierr = NF_GET_VAR_REAL(nid,var3didin(7),dt)
     340#endif
    309341         if(ierr/=NF_NOERR) then
    310342            write(*,*) NF_STRERROR(ierr)
    … …  
    313345!          write(*,*)'lecture dt ok',dt
    314346
    315          ierr = nf90_get_var(nid,var3didin(8),dq)
     347#ifdef NC_DOUBLE
     348         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),dq)
     349#else
     350         ierr = NF_GET_VAR_REAL(nid,var3didin(8),dq)
     351#endif
    316352         if(ierr/=NF_NOERR) then
    317353            write(*,*) NF_STRERROR(ierr)
    … …  
    320356!          write(*,*)'lecture dq ok',dq
    321357
    322          ierr = nf90_get_var(nid,var3didin(9),sens)
     358#ifdef NC_DOUBLE
     359         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),sens)
     360#else
     361         ierr = NF_GET_VAR_REAL(nid,var3didin(9),sens)
     362#endif
    323363         if(ierr/=NF_NOERR) then
    324364            write(*,*) NF_STRERROR(ierr)
    … …  
    327367!          write(*,*)'lecture sens ok',sens
    328368
    329          ierr = nf90_get_var(nid,var3didin(10),flat)
     369#ifdef NC_DOUBLE
     370         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),flat)
     371#else
     372         ierr = NF_GET_VAR_REAL(nid,var3didin(10),flat)
     373#endif
    330374         if(ierr/=NF_NOERR) then
    331375            write(*,*) NF_STRERROR(ierr)
    … …  
    334378!          write(*,*)'lecture flat ok',flat
    335379
    336          ierr = nf90_get_var(nid,var3didin(11),pp)
     380#ifdef NC_DOUBLE
     381         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),pp)
     382#else
     383         ierr = NF_GET_VAR_REAL(nid,var3didin(11),pp)
     384#endif
    337385         if(ierr/=NF_NOERR) then
    338386            write(*,*) NF_STRERROR(ierr)
    … …  
    381429
    382430
    383         if (forcing_type==6) then
     431        if (forcing_type.eq.6) then
    384432! Check that initial day of the simulation consistent with AMMA case:
    385        if (annee_ref/=2006) then
     433       if (annee_ref.ne.2006) then
    386434        print*,'Pour AMMA, annee_ref doit etre 2006'
    387435        print*,'Changer annee_ref dans run.def'
    388436        stop
    389437       endif
    390        if (annee_ref==2006 .and. day1<day_ini_amma) then
    391         print*,'AMMA a d�but� le 10 juillet 2006',day1,day_ini_amma
     438       if (annee_ref.eq.2006 .and. day1.lt.day_ini_amma) then
     439        print*,'AMMA a débuté le 10 juillet 2006',day1,day_ini_amma
    392440        print*,'Changer dayref dans run.def'
    393441        stop
    394442       endif
    395        if (annee_ref==2006 .and. day1>day_ini_amma+1) then
     443       if (annee_ref.eq.2006 .and. day1.gt.day_ini_amma+1) then
    396444        print*,'AMMA a fini le 11 juillet'
    397445        print*,'Changer dayref ou nday dans run.def'
    … …  
    416464
    417465       it_amma1=INT(timeit/dt_amma)+1
    418        IF (it_amma1 == nt_amma) THEN
     466       IF (it_amma1 .EQ. nt_amma) THEN
    419467       it_amma2=it_amma1
    420468       ELSE
    … …  
    424472       time_amma2=(it_amma2-1)*dt_amma
    425473
    426        if (it_amma1 > nt_amma) then
     474       if (it_amma1 .gt. nt_amma) then
    427475        write(*,*) 'PB-stop: day, it_amma1, it_amma2, timeit: '            &
    428476     &        ,day,day_ini_amma,it_amma1,it_amma2,timeit/86400.
    … …  
    431479
    432480! time interpolation:
    433        IF (it_amma1 == it_amma2) THEN
     481       IF (it_amma1 .EQ. it_amma2) THEN
    434482          frac=0.
    435483       ELSE
    … …  
    455503        END
    456504
    457 END MODULE mod_1D_amma_read

  • LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read.F90

    r5075 r5084  
     1!
     2! $Id$
     3!
    14MODULE mod_1D_cases_read
    2   USE lmdz_netcdf, ONLY: nf_noerr,nf_strerror,nf_inq_varid,nf_inq_dimlen,nf_inq_dimid,&
    3           nf_nowrite,nf_open,nf90_get_var
    45
    56!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    67!Declarations specifiques au cas standard
    78        character*80 :: fich_cas
    8 ! Discr?tisation
     9! Discr?tisation 
    910        integer nlev_cas, nt_cas
    1011
    … …  
    5657        real, allocatable::  q_prof_cas(:)
    5758        real, allocatable::  u_prof_cas(:)
    58         real, allocatable::  v_prof_cas(:)
     59        real, allocatable::  v_prof_cas(:)       
    5960
    6061        real, allocatable::  vitw_prof_cas(:)
    … …  
    8182
    8283        real lat_prof_cas,sens_prof_cas,ts_prof_cas,ustar_prof_cas
    83 
     84     
    8485
    8586
    … …  
    8788
    8889SUBROUTINE read_1D_cas
     90      implicit none
     91
     92      INCLUDE "netcdf.inc"
    8993
    9094      INTEGER nid,rid,ierr
    … …  
    9599      ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    96100      print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    97       if (ierr/=NF_NOERR) then
     101      if (ierr.NE.NF_NOERR) then
    98102         write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    99103         write(*,*) NF_STRERROR(ierr)
    … …  
    102106!.......................................................................
    103107      ierr=NF_INQ_DIMID(nid,'lat',rid)
    104       IF (ierr/=NF_NOERR) THEN
     108      IF (ierr.NE.NF_NOERR) THEN
    105109         print*, 'Oh probleme lecture dimension lat'
    106110      ENDIF
    … …  
    109113!.......................................................................
    110114      ierr=NF_INQ_DIMID(nid,'lon',rid)
    111       IF (ierr/=NF_NOERR) THEN
     115      IF (ierr.NE.NF_NOERR) THEN
    112116         print*, 'Oh probleme lecture dimension lon'
    113117      ENDIF
    … …  
    116120!.......................................................................
    117121      ierr=NF_INQ_DIMID(nid,'lev',rid)
    118       IF (ierr/=NF_NOERR) THEN
     122      IF (ierr.NE.NF_NOERR) THEN
    119123         print*, 'Oh probleme lecture dimension zz'
    120124      ENDIF
    … …  
    125129      print*,'nid,rid',nid,rid
    126130      nt_cas=0
    127       IF (ierr/=NF_NOERR) THEN
     131      IF (ierr.NE.NF_NOERR) THEN
    128132        stop 'probleme lecture dimension sens'
    129133      ENDIF
    … …  
    133137!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    134138!profils moyens:
    135         allocate(plev_cas(nlev_cas,nt_cas))
     139        allocate(plev_cas(nlev_cas,nt_cas))       
    136140        allocate(z_cas(nlev_cas,nt_cas))
    137141        allocate(t_cas(nlev_cas,nt_cas),q_cas(nlev_cas,nt_cas),rh_cas(nlev_cas,nt_cas))
    … …  
    200204!profils environnementaux:
    201205        deallocate(plev_cas)
    202 
     206       
    203207        deallocate(z_cas)
    204208        deallocate(t_cas,q_cas,rh_cas)
    … …  
    206210        deallocate(u_cas)
    207211        deallocate(v_cas)
    208 
     212       
    209213!forcing
    210214        deallocate(ht_cas,vt_cas,dt_cas,dtrad_cas)
    … …  
    253257END SUBROUTINE deallocate_1D_cases
    254258
    255   !=====================================================================
     259
     260END MODULE mod_1D_cases_read
     261!=====================================================================
    256262      subroutine read_cas(nid,nlevel,ntime                          &
    257263     &     ,zz,pp,temp,qv,rh,theta,rv,u,v,ug,vg,w,                   &
    … …  
    260266
    261267!program reading forcing of the case study
     268      implicit none
     269      INCLUDE "netcdf.inc"
    262270
    263271      integer ntime,nlevel
    … …  
    288296      integer var3didin(nbvar3d)
    289297
    290        ierr=NF_INQ_VARID(nid,"zz",var3didin(1))
     298       ierr=NF_INQ_VARID(nid,"zz",var3didin(1)) 
    291299         if(ierr/=NF_NOERR) then
    292300           write(*,*) NF_STRERROR(ierr)
    293301           stop 'lev'
    294302         endif
    295 
    296       ierr=NF_INQ_VARID(nid,"pp",var3didin(2))
     303     
     304      ierr=NF_INQ_VARID(nid,"pp",var3didin(2)) 
    297305         if(ierr/=NF_NOERR) then
    298306           write(*,*) NF_STRERROR(ierr)
    … …  
    421429           stop 'advq'
    422430         endif
    423 
     431     
    424432      ierr=NF_INQ_VARID(nid,"hq",var3didin(23))
    425433         if(ierr/=NF_NOERR) then
    … …  
    457465           stop 'advr'
    458466         endif
    459 
     467     
    460468      ierr=NF_INQ_VARID(nid,"hr",var3didin(29))
    461469         if(ierr/=NF_NOERR) then
    … …  
    523531           stop 'q2'
    524532         endif
    525 
    526          ierr = nf90_get_var(nid,var3didin(1),zz)
     533 
     534#ifdef NC_DOUBLE
     535         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz)
     536#else
     537         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz)
     538#endif
    527539         if(ierr/=NF_NOERR) then
    528540            write(*,*) NF_STRERROR(ierr)
    … …  
    531543!          write(*,*)'lecture z ok',zz
    532544
    533          ierr = nf90_get_var(nid,var3didin(2),pp)
     545#ifdef NC_DOUBLE
     546         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),pp)
     547#else
     548         ierr = NF_GET_VAR_REAL(nid,var3didin(2),pp)
     549#endif
    534550         if(ierr/=NF_NOERR) then
    535551            write(*,*) NF_STRERROR(ierr)
    … …  
    539555
    540556
    541          ierr = nf90_get_var(nid,var3didin(3),temp)
     557#ifdef NC_DOUBLE
     558         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),temp)
     559#else
     560         ierr = NF_GET_VAR_REAL(nid,var3didin(3),temp)
     561#endif
    542562         if(ierr/=NF_NOERR) then
    543563            write(*,*) NF_STRERROR(ierr)
    … …  
    546566!          write(*,*)'lecture T ok',temp
    547567
    548          ierr = nf90_get_var(nid,var3didin(4),qv)
     568#ifdef NC_DOUBLE
     569         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),qv)
     570#else
     571         ierr = NF_GET_VAR_REAL(nid,var3didin(4),qv)
     572#endif
    549573         if(ierr/=NF_NOERR) then
    550574            write(*,*) NF_STRERROR(ierr)
    … …  
    552576         endif
    553577!          write(*,*)'lecture qv ok',qv
    554 
    555          ierr = nf90_get_var(nid,var3didin(5),rh)
     578 
     579#ifdef NC_DOUBLE
     580         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),rh)
     581#else
     582         ierr = NF_GET_VAR_REAL(nid,var3didin(5),rh)
     583#endif
    556584         if(ierr/=NF_NOERR) then
    557585            write(*,*) NF_STRERROR(ierr)
    … …  
    560588!          write(*,*)'lecture rh ok',rh
    561589
    562          ierr = nf90_get_var(nid,var3didin(6),theta)
     590#ifdef NC_DOUBLE
     591         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),theta)
     592#else
     593         ierr = NF_GET_VAR_REAL(nid,var3didin(6),theta)
     594#endif
    563595         if(ierr/=NF_NOERR) then
    564596            write(*,*) NF_STRERROR(ierr)
    … …  
    567599!          write(*,*)'lecture theta ok',theta
    568600
    569          ierr = nf90_get_var(nid,var3didin(7),rv)
     601#ifdef NC_DOUBLE
     602         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),rv)
     603#else
     604         ierr = NF_GET_VAR_REAL(nid,var3didin(7),rv)
     605#endif
    570606         if(ierr/=NF_NOERR) then
    571607            write(*,*) NF_STRERROR(ierr)
    … …  
    574610!          write(*,*)'lecture rv ok',rv
    575611
    576          ierr = nf90_get_var(nid,var3didin(8),u)
     612#ifdef NC_DOUBLE
     613         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),u)
     614#else
     615         ierr = NF_GET_VAR_REAL(nid,var3didin(8),u)
     616#endif
    577617         if(ierr/=NF_NOERR) then
    578618            write(*,*) NF_STRERROR(ierr)
    … …  
    581621!          write(*,*)'lecture u ok',u
    582622
    583          ierr = nf90_get_var(nid,var3didin(9),v)
     623#ifdef NC_DOUBLE
     624         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),v)
     625#else
     626         ierr = NF_GET_VAR_REAL(nid,var3didin(9),v)
     627#endif
    584628         if(ierr/=NF_NOERR) then
    585629            write(*,*) NF_STRERROR(ierr)
    … …  
    588632!          write(*,*)'lecture v ok',v
    589633
    590          ierr = nf90_get_var(nid,var3didin(10),ug)
     634#ifdef NC_DOUBLE
     635         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),ug)
     636#else
     637         ierr = NF_GET_VAR_REAL(nid,var3didin(10),ug)
     638#endif
    591639         if(ierr/=NF_NOERR) then
    592640            write(*,*) NF_STRERROR(ierr)
    … …  
    595643!          write(*,*)'lecture ug ok',ug
    596644
    597          ierr = nf90_get_var(nid,var3didin(11),vg)
     645#ifdef NC_DOUBLE
     646         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),vg)
     647#else
     648         ierr = NF_GET_VAR_REAL(nid,var3didin(11),vg)
     649#endif
    598650         if(ierr/=NF_NOERR) then
    599651            write(*,*) NF_STRERROR(ierr)
    … …  
    602654!          write(*,*)'lecture vg ok',vg
    603655
    604          ierr = nf90_get_var(nid,var3didin(12),w)
     656#ifdef NC_DOUBLE
     657         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),w)
     658#else
     659         ierr = NF_GET_VAR_REAL(nid,var3didin(12),w)
     660#endif
    605661         if(ierr/=NF_NOERR) then
    606662            write(*,*) NF_STRERROR(ierr)
    … …  
    609665!          write(*,*)'lecture w ok',w
    610666
    611          ierr = nf90_get_var(nid,var3didin(13),du)
     667#ifdef NC_DOUBLE
     668         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(13),du)
     669#else
     670         ierr = NF_GET_VAR_REAL(nid,var3didin(13),du)
     671#endif
    612672         if(ierr/=NF_NOERR) then
    613673            write(*,*) NF_STRERROR(ierr)
    … …  
    616676!          write(*,*)'lecture du ok',du
    617677
    618          ierr = nf90_get_var(nid,var3didin(14),hu)
     678#ifdef NC_DOUBLE
     679         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),hu)
     680#else
     681         ierr = NF_GET_VAR_REAL(nid,var3didin(14),hu)
     682#endif
    619683         if(ierr/=NF_NOERR) then
    620684            write(*,*) NF_STRERROR(ierr)
    … …  
    623687!          write(*,*)'lecture hu ok',hu
    624688
    625          ierr = nf90_get_var(nid,var3didin(15),vu)
     689#ifdef NC_DOUBLE
     690         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),vu)
     691#else
     692         ierr = NF_GET_VAR_REAL(nid,var3didin(15),vu)
     693#endif
    626694         if(ierr/=NF_NOERR) then
    627695            write(*,*) NF_STRERROR(ierr)
    … …  
    630698!          write(*,*)'lecture vu ok',vu
    631699
    632          ierr = nf90_get_var(nid,var3didin(16),dv)
     700#ifdef NC_DOUBLE
     701         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),dv)
     702#else
     703         ierr = NF_GET_VAR_REAL(nid,var3didin(16),dv)
     704#endif
    633705         if(ierr/=NF_NOERR) then
    634706            write(*,*) NF_STRERROR(ierr)
    … …  
    637709!          write(*,*)'lecture dv ok',dv
    638710
    639          ierr = nf90_get_var(nid,var3didin(17),hv)
     711#ifdef NC_DOUBLE
     712         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(17),hv)
     713#else
     714         ierr = NF_GET_VAR_REAL(nid,var3didin(17),hv)
     715#endif
    640716         if(ierr/=NF_NOERR) then
    641717            write(*,*) NF_STRERROR(ierr)
    … …  
    644720!          write(*,*)'lecture hv ok',hv
    645721
    646          ierr = nf90_get_var(nid,var3didin(18),vv)
     722#ifdef NC_DOUBLE
     723         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(18),vv)
     724#else
     725         ierr = NF_GET_VAR_REAL(nid,var3didin(18),vv)
     726#endif
    647727         if(ierr/=NF_NOERR) then
    648728            write(*,*) NF_STRERROR(ierr)
    … …  
    651731!          write(*,*)'lecture vv ok',vv
    652732
    653          ierr = nf90_get_var(nid,var3didin(19),dt)
     733#ifdef NC_DOUBLE
     734         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(19),dt)
     735#else
     736         ierr = NF_GET_VAR_REAL(nid,var3didin(19),dt)
     737#endif
    654738         if(ierr/=NF_NOERR) then
    655739            write(*,*) NF_STRERROR(ierr)
    … …  
    658742!          write(*,*)'lecture dt ok',dt
    659743
    660          ierr = nf90_get_var(nid,var3didin(20),ht)
     744#ifdef NC_DOUBLE
     745         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(20),ht)
     746#else
     747         ierr = NF_GET_VAR_REAL(nid,var3didin(20),ht)
     748#endif
    661749         if(ierr/=NF_NOERR) then
    662750            write(*,*) NF_STRERROR(ierr)
    … …  
    665753!          write(*,*)'lecture ht ok',ht
    666754
    667          ierr = nf90_get_var(nid,var3didin(21),vt)
     755#ifdef NC_DOUBLE
     756         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(21),vt)
     757#else
     758         ierr = NF_GET_VAR_REAL(nid,var3didin(21),vt)
     759#endif
    668760         if(ierr/=NF_NOERR) then
    669761            write(*,*) NF_STRERROR(ierr)
    … …  
    672764!          write(*,*)'lecture vt ok',vt
    673765
    674          ierr = nf90_get_var(nid,var3didin(22),dq)
     766#ifdef NC_DOUBLE
     767         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(22),dq)
     768#else
     769         ierr = NF_GET_VAR_REAL(nid,var3didin(22),dq)
     770#endif
    675771         if(ierr/=NF_NOERR) then
    676772            write(*,*) NF_STRERROR(ierr)
    … …  
    679775!          write(*,*)'lecture dq ok',dq
    680776
    681          ierr = nf90_get_var(nid,var3didin(23),hq)
     777#ifdef NC_DOUBLE
     778         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(23),hq)
     779#else
     780         ierr = NF_GET_VAR_REAL(nid,var3didin(23),hq)
     781#endif
    682782         if(ierr/=NF_NOERR) then
    683783            write(*,*) NF_STRERROR(ierr)
    … …  
    686786!          write(*,*)'lecture hq ok',hq
    687787
    688          ierr = nf90_get_var(nid,var3didin(24),vq)
     788#ifdef NC_DOUBLE
     789         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(24),vq)
     790#else
     791         ierr = NF_GET_VAR_REAL(nid,var3didin(24),vq)
     792#endif
    689793         if(ierr/=NF_NOERR) then
    690794            write(*,*) NF_STRERROR(ierr)
    … …  
    693797!          write(*,*)'lecture vq ok',vq
    694798
    695          ierr = nf90_get_var(nid,var3didin(25),dth)
     799#ifdef NC_DOUBLE
     800         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(25),dth)
     801#else
     802         ierr = NF_GET_VAR_REAL(nid,var3didin(25),dth)
     803#endif
    696804         if(ierr/=NF_NOERR) then
    697805            write(*,*) NF_STRERROR(ierr)
    … …  
    700808!          write(*,*)'lecture dth ok',dth
    701809
    702          ierr = nf90_get_var(nid,var3didin(26),hth)
     810#ifdef NC_DOUBLE
     811         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(26),hth)
     812#else
     813         ierr = NF_GET_VAR_REAL(nid,var3didin(26),hth)
     814#endif
    703815         if(ierr/=NF_NOERR) then
    704816            write(*,*) NF_STRERROR(ierr)
    … …  
    707819!          write(*,*)'lecture hth ok',hth
    708820
    709          ierr = nf90_get_var(nid,var3didin(27),vth)
     821#ifdef NC_DOUBLE
     822         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(27),vth)
     823#else
     824         ierr = NF_GET_VAR_REAL(nid,var3didin(27),vth)
     825#endif
    710826         if(ierr/=NF_NOERR) then
    711827            write(*,*) NF_STRERROR(ierr)
    … …  
    714830!          write(*,*)'lecture vth ok',vth
    715831
    716          ierr = nf90_get_var(nid,var3didin(28),dr)
     832#ifdef NC_DOUBLE
     833         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(28),dr)
     834#else
     835         ierr = NF_GET_VAR_REAL(nid,var3didin(28),dr)
     836#endif
    717837         if(ierr/=NF_NOERR) then
    718838            write(*,*) NF_STRERROR(ierr)
    … …  
    721841!          write(*,*)'lecture dr ok',dr
    722842
    723          ierr = nf90_get_var(nid,var3didin(29),hr)
     843#ifdef NC_DOUBLE
     844         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(29),hr)
     845#else
     846         ierr = NF_GET_VAR_REAL(nid,var3didin(29),hr)
     847#endif
    724848         if(ierr/=NF_NOERR) then
    725849            write(*,*) NF_STRERROR(ierr)
    … …  
    728852!          write(*,*)'lecture hr ok',hr
    729853
    730          ierr = nf90_get_var(nid,var3didin(30),vr)
     854#ifdef NC_DOUBLE
     855         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(30),vr)
     856#else
     857         ierr = NF_GET_VAR_REAL(nid,var3didin(30),vr)
     858#endif
    731859         if(ierr/=NF_NOERR) then
    732860            write(*,*) NF_STRERROR(ierr)
    … …  
    735863!          write(*,*)'lecture vr ok',vr
    736864
    737          ierr = nf90_get_var(nid,var3didin(31),dtrad)
     865#ifdef NC_DOUBLE
     866         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(31),dtrad)
     867#else
     868         ierr = NF_GET_VAR_REAL(nid,var3didin(31),dtrad)
     869#endif
    738870         if(ierr/=NF_NOERR) then
    739871            write(*,*) NF_STRERROR(ierr)
    … …  
    742874!          write(*,*)'lecture dtrad ok',dtrad
    743875
    744          ierr = nf90_get_var(nid,var3didin(32),sens)
     876#ifdef NC_DOUBLE
     877         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(32),sens)
     878#else
     879         ierr = NF_GET_VAR_REAL(nid,var3didin(32),sens)
     880#endif
    745881         if(ierr/=NF_NOERR) then
    746882            write(*,*) NF_STRERROR(ierr)
    … …  
    749885!          write(*,*)'lecture sens ok',sens
    750886
    751          ierr = nf90_get_var(nid,var3didin(33),flat)
     887#ifdef NC_DOUBLE
     888         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(33),flat)
     889#else
     890         ierr = NF_GET_VAR_REAL(nid,var3didin(33),flat)
     891#endif
    752892         if(ierr/=NF_NOERR) then
    753893            write(*,*) NF_STRERROR(ierr)
    … …  
    756896!          write(*,*)'lecture flat ok',flat
    757897
    758          ierr = nf90_get_var(nid,var3didin(34),ts)
     898#ifdef NC_DOUBLE
     899         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(34),ts)
     900#else
     901         ierr = NF_GET_VAR_REAL(nid,var3didin(34),ts)
     902#endif
    759903         if(ierr/=NF_NOERR) then
    760904            write(*,*) NF_STRERROR(ierr)
    … …  
    763907!          write(*,*)'lecture ts ok',ts
    764908
    765          ierr = nf90_get_var(nid,var3didin(35),ustar)
     909#ifdef NC_DOUBLE
     910         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(35),ustar)
     911#else
     912         ierr = NF_GET_VAR_REAL(nid,var3didin(35),ustar)
     913#endif
    766914         if(ierr/=NF_NOERR) then
    767915            write(*,*) NF_STRERROR(ierr)
    … …  
    770918!         write(*,*)'lecture ustar ok',ustar
    771919
    772          ierr = nf90_get_var(nid,var3didin(36),uw)
     920#ifdef NC_DOUBLE
     921         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(36),uw)
     922#else
     923         ierr = NF_GET_VAR_REAL(nid,var3didin(36),uw)
     924#endif
    773925         if(ierr/=NF_NOERR) then
    774926            write(*,*) NF_STRERROR(ierr)
    … …  
    777929!         write(*,*)'lecture uw ok',uw
    778930
    779          ierr = nf90_get_var(nid,var3didin(37),vw)
     931#ifdef NC_DOUBLE
     932         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(37),vw)
     933#else
     934         ierr = NF_GET_VAR_REAL(nid,var3didin(37),vw)
     935#endif
    780936         if(ierr/=NF_NOERR) then
    781937            write(*,*) NF_STRERROR(ierr)
    … …  
    784940!         write(*,*)'lecture vw ok',vw
    785941
    786          ierr = nf90_get_var(nid,var3didin(38),q1)
     942#ifdef NC_DOUBLE
     943         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(38),q1)
     944#else
     945         ierr = NF_GET_VAR_REAL(nid,var3didin(38),q1)
     946#endif
    787947         if(ierr/=NF_NOERR) then
    788948            write(*,*) NF_STRERROR(ierr)
    … …  
    791951!         write(*,*)'lecture q1 ok',q1
    792952
    793          ierr = nf90_get_var(nid,var3didin(39),q2)
     953#ifdef NC_DOUBLE
     954         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(39),q2)
     955#else
     956         ierr = NF_GET_VAR_REAL(nid,var3didin(39),q2)
     957#endif
    794958         if(ierr/=NF_NOERR) then
    795959            write(*,*) NF_STRERROR(ierr)
    … …  
    799963
    800964
    801          return
     965         return 
    802966         end subroutine read_cas
    803967!======================================================================
    … …  
    817981     &         ,hq_prof_cas,vq_prof_cas,lat_prof_cas,sens_prof_cas    &
    818982     &         ,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas)
    819 
     983         
    820984
    821985        implicit none
    … …  
    826990! day: current julian day (e.g. 717538.2)
    827991! day1: first day of the simulation
    828 ! nt_cas: total nb of data in the forcing
     992! nt_cas: total nb of data in the forcing 
    829993! pdt_cas: total time interval (in sec) between 2 forcing data
    830994!---------------------------------------------------------------------------------------
    … …  
    9171081
    9181082       it_cas1=INT(timeit/pdt_cas)+1
    919        IF (it_cas1 == nt_cas) THEN
    920        it_cas2=it_cas1
     1083       IF (it_cas1 .EQ. nt_cas) THEN
     1084       it_cas2=it_cas1 
    9211085       ELSE
    9221086       it_cas2=it_cas1 + 1
    … …  
    9291093      print *,'time_cas2=',time_cas2
    9301094
    931        if (it_cas1 > nt_cas) then
     1095       if (it_cas1 .gt. nt_cas) then
    9321096        write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    9331097     &        ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    … …  
    9361100
    9371101! time interpolation:
    938        IF (it_cas1 == it_cas2) THEN
     1102       IF (it_cas1 .EQ. it_cas2) THEN
    9391103          frac=0.
    9401104       ELSE
    … …  
    9441108
    9451109       lat_prof_cas = lat_cas(it_cas2)                                       &
    946      &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1))
     1110     &          -frac*(lat_cas(it_cas2)-lat_cas(it_cas1)) 
    9471111       sens_prof_cas = sens_cas(it_cas2)                                     &
    9481112     &          -frac*(sens_cas(it_cas2)-sens_cas(it_cas1))
    … …  
    10091173
    10101174!**********************************************************************************************
    1011 END MODULE mod_1D_cases_read

  • LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

    r5075 r5084  
    33!
    44MODULE mod_1D_cases_read2
    5   USE lmdz_netcdf, ONLY: nf90_get_var,nf_noerr,nf_inq_varid,nf_inq_dimlen,nf_strerror,nf_open,&
    6           nf_nowrite,nf_inq_dimid
     5
    76!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    87  !Declarations specifiques au cas standard
    … …  
    8281    implicit none
    8382
     83    INCLUDE "netcdf.inc"
     84
    8485    INTEGER nid,rid,ierr
    8586    INTEGER ii,jj
    … …  
    8990    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    9091    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    91     if (ierr/=NF_NOERR) then
     92    if (ierr.NE.NF_NOERR) then
    9293       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    9394       write(*,*) NF_STRERROR(ierr)
    … …  
    9697    !.......................................................................
    9798    ierr=NF_INQ_DIMID(nid,'lat',rid)
    98     IF (ierr/=NF_NOERR) THEN
     99    IF (ierr.NE.NF_NOERR) THEN
    99100       print*, 'Oh probleme lecture dimension lat'
    100101    ENDIF
    … …  
    103104    !.......................................................................
    104105    ierr=NF_INQ_DIMID(nid,'lon',rid)
    105     IF (ierr/=NF_NOERR) THEN
     106    IF (ierr.NE.NF_NOERR) THEN
    106107       print*, 'Oh probleme lecture dimension lon'
    107108    ENDIF
    … …  
    110111    !.......................................................................
    111112    ierr=NF_INQ_DIMID(nid,'lev',rid)
    112     IF (ierr/=NF_NOERR) THEN
     113    IF (ierr.NE.NF_NOERR) THEN
    113114       print*, 'Oh probleme lecture dimension zz'
    114115    ENDIF
    … …  
    119120    print*,'nid,rid',nid,rid
    120121    nt_cas=0
    121     IF (ierr/=NF_NOERR) THEN
     122    IF (ierr.NE.NF_NOERR) THEN
    122123       stop 'probleme lecture dimension sens'
    123124    ENDIF
    … …  
    191192    implicit none
    192193
     194    INCLUDE "netcdf.inc"
     195
    193196    INTEGER nid,rid,ierr
    194197    INTEGER ii,jj
    … …  
    198201    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    199202    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    200     if (ierr/=NF_NOERR) then
     203    if (ierr.NE.NF_NOERR) then
    201204       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    202205       write(*,*) NF_STRERROR(ierr)
    … …  
    205208    !.......................................................................
    206209    ierr=NF_INQ_DIMID(nid,'lat',rid)
    207     IF (ierr/=NF_NOERR) THEN
     210    IF (ierr.NE.NF_NOERR) THEN
    208211       print*, 'Oh probleme lecture dimension lat'
    209212    ENDIF
    … …  
    212215    !.......................................................................
    213216    ierr=NF_INQ_DIMID(nid,'lon',rid)
    214     IF (ierr/=NF_NOERR) THEN
     217    IF (ierr.NE.NF_NOERR) THEN
    215218       print*, 'Oh probleme lecture dimension lon'
    216219    ENDIF
    … …  
    219222    !.......................................................................
    220223    ierr=NF_INQ_DIMID(nid,'nlev',rid)
    221     IF (ierr/=NF_NOERR) THEN
     224    IF (ierr.NE.NF_NOERR) THEN
    222225       print*, 'Oh probleme lecture dimension nlev'
    223226    ENDIF
    … …  
    227230    ierr=NF_INQ_DIMID(nid,'time',rid)
    228231    nt_cas=0
    229     IF (ierr/=NF_NOERR) THEN
     232    IF (ierr.NE.NF_NOERR) THEN
    230233       stop 'Oh probleme lecture dimension time'
    231234    ENDIF
    … …  
    314317  !**********************************************************************************************
    315318  SUBROUTINE old_read_SCM_cas
     319    use netcdf, only: nf90_get_var
    316320    implicit none
    317321
     322    INCLUDE "netcdf.inc"
    318323    INCLUDE "date_cas.h"
    319324
    … …  
    326331    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    327332    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    328     if (ierr/=NF_NOERR) then
     333    if (ierr.NE.NF_NOERR) then
    329334       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    330335       write(*,*) NF_STRERROR(ierr)
    … …  
    333338    !.......................................................................
    334339    ierr=NF_INQ_DIMID(nid,'lat',rid)
    335     IF (ierr/=NF_NOERR) THEN
     340    IF (ierr.NE.NF_NOERR) THEN
    336341       print*, 'Oh probleme lecture dimension lat'
    337342    ENDIF
    … …  
    340345    !.......................................................................
    341346    ierr=NF_INQ_DIMID(nid,'lon',rid)
    342     IF (ierr/=NF_NOERR) THEN
     347    IF (ierr.NE.NF_NOERR) THEN
    343348       print*, 'Oh probleme lecture dimension lon'
    344349    ENDIF
    … …  
    347352    !.......................................................................
    348353    ierr=NF_INQ_DIMID(nid,'lev',rid)
    349     IF (ierr/=NF_NOERR) THEN
     354    IF (ierr.NE.NF_NOERR) THEN
    350355       print*, 'Oh probleme lecture dimension nlev'
    351356    ENDIF
    … …  
    359364    ierr=NF_INQ_DIMID(nid,'time',rid)
    360365    nt_cas=0
    361     IF (ierr/=NF_NOERR) THEN
     366    IF (ierr.NE.NF_NOERR) THEN
    362367       stop 'Oh probleme lecture dimension time'
    363368    ENDIF
    … …  
    528533
    529534
     535END MODULE mod_1D_cases_read2
    530536!=====================================================================
    531537subroutine read_cas2(nid,nlevel,ntime                          &
    … …  
    535541
    536542  !program reading forcing of the case study
     543  use netcdf, only: nf90_get_var
    537544  implicit none
     545  INCLUDE "netcdf.inc"
    538546
    539547  integer ntime,nlevel
    … …  
    581589  do i=1,nbvar3d
    582590     print *,'Dans read_cas2, on va lire ',var3didin(i),name_var(i)
    583      if(i<=35) then
     591     if(i.LE.35) then
    584592        ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    585593        print *,'Dans read_cas2, on a lu ',ierr,var3didin(i),name_var(i)
    … …  
    650658
    651659  !program reading forcing of the case study
     660  use netcdf, only: nf90_get_var
    652661  implicit none
     662  INCLUDE "netcdf.inc"
    653663
    654664  integer ntime,nlevel
    … …  
    701711     else
    702712        !-----------------------------------------------------------------------
    703         if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
     713        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    704714           ierr = NF90_GET_VAR(nid,var3didin(i),apbp, count = [1, 1, nlevel + 1])
    705715           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    … …  
    709719           endif
    710720           !-----------------------------------------------------------------------
    711         else if(i>4.and.i<=45) then   ! Lecture des variables en (time,nlevel,lat,lon)
     721        else if(i.gt.4.and.i.LE.45) then   ! Lecture des variables en (time,nlevel,lat,lon)
    712722           ierr = NF90_GET_VAR(nid,var3didin(i),resul, count = [1, 1, nlevel, ntime])
    713723           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    … …  
    717727           endif
    718728           !-----------------------------------------------------------------------
    719         else if (i>45.and.i<=51) then   ! Lecture des variables en (time,lat,lon)
     729        else if (i.gt.45.and.i.LE.51) then   ! Lecture des variables en (time,lat,lon)
    720730           ierr = NF90_GET_VAR(nid,var3didin(i),resul2, count = [1, 1, ntime])
    721731           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    … …  
    819829
    820830  !program reading forcing of the case study
     831  use netcdf, only: nf90_get_var
    821832  implicit none
     833  INCLUDE "netcdf.inc"
    822834
    823835  integer ntime,nlevel,k,t
    … …  
    876888     else
    877889        !-----------------------------------------------------------------------
    878         if(i<=4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
     890        if(i.LE.4) then     ! Lecture des coord pression en (nlevelp1,lat,lon)
    879891           ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
    880892           print *,'read2_cas(apbp), on a lu ',i,name_var(i)
    … …  
    884896           endif
    885897           !-----------------------------------------------------------------------
    886         else if(i>4.and.i<=12) then   ! Lecture des variables en (time,nlevel,lat,lon)
     898        else if(i.gt.4.and.i.LE.12) then   ! Lecture des variables en (time,nlevel,lat,lon)
    887899           ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
    888900           print *,'read2_cas(resul1), on a lu ',i,name_var(i)
    … …  
    893905           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul1),maxval(resul1)
    894906           !-----------------------------------------------------------------------
    895         else if(i>12.and.i<=54) then   ! Lecture des variables en (time,nlevel,lat,lon)
     907        else if(i.gt.12.and.i.LE.54) then   ! Lecture des variables en (time,nlevel,lat,lon)
    896908           ierr = NF90_GET_VAR(nid,var3didin(i),resul)
    897909           print *,'read2_cas(resul), on a lu ',i,name_var(i)
    … …  
    902914           print*,'Lecture de la variable #i ',i,name_var(i),minval(resul),maxval(resul)
    903915           !-----------------------------------------------------------------------
    904         else if (i>54.and.i<=65) then   ! Lecture des variables en (time,lat,lon)
     916        else if (i.gt.54.and.i.LE.65) then   ! Lecture des variables en (time,lat,lon)
    905917           ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
    906918           print *,'read2_cas(resul2), on a lu ',i,name_var(i)
    … …  
    11361148
    11371149  it_cas1=INT(timeit/pdt_cas)+1
    1138   IF (it_cas1 == nt_cas) THEN
     1150  IF (it_cas1 .EQ. nt_cas) THEN
    11391151     it_cas2=it_cas1
    11401152  ELSE
    … …  
    11451157  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    11461158
    1147   if (it_cas1 > nt_cas) then
     1159  if (it_cas1 .gt. nt_cas) then
    11481160     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    11491161          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    … …  
    11521164
    11531165  ! time interpolation:
    1154   IF (it_cas1 == it_cas2) THEN
     1166  IF (it_cas1 .EQ. it_cas2) THEN
    11551167     frac=0.
    11561168  ELSE
    … …  
    13511363
    13521364  it_cas1=INT(timeit/pdt_cas)+1
    1353   IF (it_cas1 == nt_cas) THEN
     1365  IF (it_cas1 .EQ. nt_cas) THEN
    13541366     it_cas2=it_cas1
    13551367  ELSE
    … …  
    13611373  !print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    13621374
    1363   if (it_cas1 > nt_cas) then
     1375  if (it_cas1 .gt. nt_cas) then
    13641376     write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    13651377          ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    … …  
    13681380
    13691381  ! time interpolation:
    1370   IF (it_cas1 == it_cas2) THEN
     1382  IF (it_cas1 .EQ. it_cas2) THEN
    13711383     frac=0.
    13721384  ELSE
    … …  
    14631475!**********************************************************************************************
    14641476
    1465 END MODULE mod_1D_cases_read2

  • LMDZ6/trunk/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90

    r5075 r5084  
    33!
    44MODULE mod_1D_cases_read_std
    5   USE lmdz_netcdf, ONLY:nf_noerr,nf_inq_varid,nf_inq_dimid,nf_inq_dimlen,nf_open,nf_nowrite,&
    6           nf_strerror,nf90_get_var
    75
    86!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    8987  !**********************************************************************************************
    9088  SUBROUTINE read_SCM_cas
     89    use netcdf, only: nf90_get_var
    9190    implicit none
    9291
     92    INCLUDE "netcdf.inc"
    9393    INCLUDE "date_cas.h"
    9494
    … …  
    101101    ierr = NF_OPEN(fich_cas,NF_NOWRITE,nid)
    102102    print*,'fich_cas,NF_NOWRITE,nid ',fich_cas,NF_NOWRITE,nid
    103     if (ierr/=NF_NOERR) then
     103    if (ierr.NE.NF_NOERR) then
    104104       write(*,*) 'ERROR: GROS Pb opening forcings nc file '
    105105       write(*,*) NF_STRERROR(ierr)
    … …  
    108108    !.......................................................................
    109109    ierr=NF_INQ_DIMID(nid,'lat',rid)
    110     IF (ierr/=NF_NOERR) THEN
     110    IF (ierr.NE.NF_NOERR) THEN
    111111       print*, 'Oh probleme lecture dimension lat'
    112112    ENDIF
    … …  
    115115    !.......................................................................
    116116    ierr=NF_INQ_DIMID(nid,'lon',rid)
    117     IF (ierr/=NF_NOERR) THEN
     117    IF (ierr.NE.NF_NOERR) THEN
    118118       print*, 'Oh probleme lecture dimension lon'
    119119    ENDIF
    … …  
    122122    !.......................................................................
    123123    ierr=NF_INQ_DIMID(nid,'lev',rid)
    124     IF (ierr/=NF_NOERR) THEN
     124    IF (ierr.NE.NF_NOERR) THEN
    125125       print*, 'Oh probleme lecture dimension nlev'
    126126    ENDIF
    … …  
    134134    ierr=NF_INQ_DIMID(nid,'time',rid)
    135135    nt_cas=0
    136     IF (ierr/=NF_NOERR) THEN
     136    IF (ierr.NE.NF_NOERR) THEN
    137137       stop 'Oh probleme lecture dimension time'
    138138    ENDIF
    … …  
    329329
    330330    !program reading forcing of the case study
     331    use netcdf, only: nf90_get_var
    331332    implicit none
     333    INCLUDE "netcdf.inc"
    332334    INCLUDE "compar1d.h"
    333335
    … …  
    453455          ! Reading variables 1D (N+1) vertical variables (nlevelp1,lat,lon)
    454456          !-----------------------------------------------------------------------
    455           if(i<=4) then
     457          if(i.LE.4) then
    456458             ierr = NF90_GET_VAR(nid,var3didin(i),apbp)
    457459             print *,'read_SCM(apbp), on a lu ',i,name_var(i)
    … …  
    464466             !  Reading 1D (N) vertical varialbes    (nlevel,lat,lon)   
    465467             !-----------------------------------------------------------------------
    466           else if(i>4.and.i<=12) then
     468          else if(i.gt.4.and.i.LE.12) then 
    467469             ierr = NF90_GET_VAR(nid,var3didin(i),resul1)
    468470             print *,'read_SCM(resul1), on a lu ',i,name_var(i)
    … …  
    477479             !  TBD : seems to be the same as above.
    478480             !-----------------------------------------------------------------------
    479           else if(i>12.and.i<=61) then
     481          else if(i.gt.12.and.i.LE.61) then
    480482             ierr = NF90_GET_VAR(nid,var3didin(i),resul)
    481483             print *,'read_SCM(resul), on a lu ',i,name_var(i)
    … …  
    489491             !  Reading 1D time variables (time,lat,lon)
    490492             !-----------------------------------------------------------------------
    491           else if (i>62.and.i<=75) then
     493          else if (i.gt.62.and.i.LE.75) then
    492494             ierr = NF90_GET_VAR(nid,var3didin(i),resul2)
    493495             print *,'read_SCM(resul2), on a lu ',i,name_var(i)
    … …  
    775777
    776778    it_cas1=INT(timeit/pdt_cas)+1
    777     IF (it_cas1 == nt_cas) THEN
     779    IF (it_cas1 .EQ. nt_cas) THEN
    778780       it_cas2=it_cas1
    779781    ELSE
    … …  
    785787    !     print *,'it_cas1,it_cas2,time_cas1,time_cas2=',it_cas1,it_cas2,time_cas1,time_cas2
    786788
    787     if (it_cas1 > nt_cas) then
     789    if (it_cas1 .gt. nt_cas) then
    788790       write(*,*) 'PB-stop: day, day_ju_ini_cas,it_cas1, it_cas2, timeit: '            &
    789791            ,day,day_ju_ini_cas,it_cas1,it_cas2,timeit
    … …  
    792794
    793795    ! time interpolation:
    794     IF (it_cas1 == it_cas2) THEN
     796    IF (it_cas1 .EQ. it_cas2) THEN
    795797       frac=0.
    796798    ELSE
    … …  
    987989    do l = 1, llm
    988990
    989        if (play(l)>=plev_prof_cas(nlev_cas)) then
     991       if (play(l).ge.plev_prof_cas(nlev_cas)) then
    990992
    991993          mxcalc=l
    … …  
    994996          k2=0
    995997
    996           if (play(l)<=plev_prof_cas(1)) then
     998          if (play(l).le.plev_prof_cas(1)) then
    997999
    9981000             do k = 1, nlev_cas-1
    999                 if (play(l)<=plev_prof_cas(k).and. play(l)>plev_prof_cas(k+1)) then
     1001                if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
    10001002                   k1=k
    10011003                   k2=k+1
    … …  
    10031005             enddo
    10041006
    1005              if (k1==0 .or. k2==0) then
     1007             if (k1.eq.0 .or. k2.eq.0) then
    10061008                write(*,*) 'PB! k1, k2 = ',k1,k2
    10071009                write(*,*) 'l,play(l) = ',l,play(l)/100
    … …  
    10171019             t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
    10181020             theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
    1019              if(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
     1021             if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    10201022             thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
    10211023             thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
    … …  
    10661068             t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
    10671069             theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
    1068              if(theta_mod_cas(l)/=0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
     1070             if(theta_mod_cas(l).NE.0) t_mod_cas(l)= theta_mod_cas(l)*(play(l)/100000.)**(RD/RCPD)
    10691071             thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
    10701072             thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
    … …  
    11631165    do l = 1, llm+1
    11641166
    1165        if (plev(l)>=plev_prof_cas(nlev_cas)) then
     1167       if (plev(l).ge.plev_prof_cas(nlev_cas)) then
    11661168
    11671169          mxcalc=l
    … …  
    11691171          k2=0
    11701172
    1171           if (plev(l)<=plev_prof_cas(1)) then
     1173          if (plev(l).le.plev_prof_cas(1)) then
    11721174
    11731175             do k = 1, nlev_cas-1
    1174                 if (plev(l)<=plev_prof_cas(k).and. plev(l)>plev_prof_cas(k+1)) then
     1176                if (plev(l).le.plev_prof_cas(k).and. plev(l).gt.plev_prof_cas(k+1)) then
    11751177                   k1=k
    11761178                   k2=k+1
    … …  
    11781180             enddo
    11791181
    1180              if (k1==0 .or. k2==0) then
     1182             if (k1.eq.0 .or. k2.eq.0) then
    11811183                write(*,*) 'PB! k1, k2 = ',k1,k2
    11821184                write(*,*) 'l,plev(l) = ',l,plev(l)/100

  • LMDZ6/trunk/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5075 r5084  
    146146!program reading forcings of the TWP-ICE experiment
    147147
    148         use lmdz_netcdf, ONLY: nf_open,nf_nowrite,nf_noerr,nf_strerror,nf_inq_varid,nf90_get_var,&
    149             nf_inq_dimid,nf_inq_dimlen
    150 
     148        use netcdf, only: nf90_get_var
    151149
    152150      implicit none
     151
     152      INCLUDE "netcdf.inc"
    153153
    154154      integer ntime,nlevel
    … …  
    492492         subroutine catchaxis(nid,ttm,llm,time,lev,ierr)
    493493
    494          use lmdz_netcdf, ONLY: nf_open,nf_nowrite,nf_noerr,nf_strerror,nf_inq_varid,nf90_get_var,&
    495             nf_inq_dimid,nf_inq_dimlen
     494         use netcdf, only: nf90_get_var
    496495
    497496         implicit none
     497         INCLUDE "netcdf.inc"
    498498         integer nid,ttm,llm
    499499         real*8 time(ttm)
    … …  
    21702170
    21712171
    2172       use lmdz_netcdf, ONLY: nf_open,nf_nowrite,nf_noerr,nf_strerror,nf_inq_varid,nf90_get_var,&
    2173             nf_inq_dimid,nf_inq_dimlen
     2172      use netcdf, only: nf90_get_var
    21742173      implicit none
     2174
     2175      INCLUDE "netcdf.inc"
    21752176
    21762177      integer ntime,nlevel
    … …  
    23802381!program reading initial profils and forcings of the Dice case study
    23812382
    2382       use lmdz_netcdf, ONLY: nf_open,nf_nowrite,nf_noerr,nf_strerror,nf_inq_varid,nf90_get_var,&
    2383             nf_inq_dimid,nf_inq_dimlen
     2383      use netcdf, only: nf90_get_var
    23842384
    23852385      implicit none
    23862386
     2387      INCLUDE "netcdf.inc"
    23872388      INCLUDE "YOMCST.h"
    23882389
    … …  
    27142715!program reading initial profils and forcings of the Gabls4 case study
    27152716
    2716       use lmdz_netcdf, ONLY: nf_open,nf_nowrite,nf_noerr,nf_strerror,nf_inq_varid,nf90_get_var,&
    2717             nf_inq_dimid,nf_inq_dimlen
     2717      use netcdf, only: nf90_get_var
    27182718
    27192719      implicit none
     2720
     2721      INCLUDE "netcdf.inc"
    27202722
    27212723      integer ntime,nlevel,nsol

  • LMDZ6/trunk/libf/phylmd/dyn1d/old_1D_decl_cases.h

    r5075 r5084  
     1         INCLUDE "netcdf.inc"
    12
    23! Declarations specifiques au cas Toga

  • LMDZ6/trunk/libf/phylmd/dyn1d/old_lmdz1d.F90

    r5075 r5084  
    4444   USE temps_mod, ONLY: annee_ref, calend, day_end, day_ini, day_ref, &
    4545                        itau_dyn, itau_phy, start_time, year_len
    46    USE phys_cal_mod, ONLY : year_len_phys_cal_mod => year_len
    47    USE mod_1D_cases_read, ONLY: interp_case_time ! used in included old_1D_read_forc_cases.h
    48 
     46   USE phys_cal_mod, ONLY : year_len_phys_cal_mod => year_len
    4947
    5048      implicit none
    … …  
    368366      if (forcing_type <=0) THEN
    369367       forcing_les = .true.
    370       elseif (forcing_type ==1) THEN
     368      elseif (forcing_type .eq.1) THEN
    371369       forcing_radconv = .true.
    372       elseif (forcing_type ==2) THEN
     370      elseif (forcing_type .eq.2) THEN
    373371       forcing_toga    = .true.
    374       elseif (forcing_type ==3) THEN
     372      elseif (forcing_type .eq.3) THEN
    375373       forcing_GCM2SCM = .true.
    376       elseif (forcing_type ==4) THEN
     374      elseif (forcing_type .eq.4) THEN
    377375       forcing_twpice = .true.
    378       elseif (forcing_type ==5) THEN
     376      elseif (forcing_type .eq.5) THEN
    379377       forcing_rico = .true.
    380       elseif (forcing_type ==6) THEN
     378      elseif (forcing_type .eq.6) THEN
    381379       forcing_amma = .true.
    382       elseif (forcing_type ==7) THEN
     380      elseif (forcing_type .eq.7) THEN
    383381       forcing_dice = .true.
    384       elseif (forcing_type ==8) THEN
     382      elseif (forcing_type .eq.8) THEN
    385383       forcing_gabls4 = .true.
    386       elseif (forcing_type ==101) THEN ! Cindynamo starts 1-10-2011 0h
     384      elseif (forcing_type .eq.101) THEN ! Cindynamo starts 1-10-2011 0h
    387385       forcing_case = .true.
    388386       year_ini_cas=2011
    … …  
    391389       heure_ini_cas=0.
    392390       pdt_cas=3*3600.         ! forcing frequency
    393       elseif (forcing_type ==102) THEN ! Bomex starts 24-6-1969 0h
     391      elseif (forcing_type .eq.102) THEN ! Bomex starts 24-6-1969 0h
    394392       forcing_case = .true.
    395393       year_ini_cas=1969
    … …  
    398396       heure_ini_cas=0.
    399397       pdt_cas=1800.         ! forcing frequency
    400       elseif (forcing_type ==103) THEN ! Arm_cu starts 21-6-1997 11h30
     398      elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30
    401399       forcing_case2 = .true.
    402400       year_ini_cas=1997
    … …  
    405403       heure_ini_cas=11.5
    406404       pdt_cas=1800.         ! forcing frequency
    407       elseif (forcing_type ==104) THEN ! rico starts 16-12-2004 0h
     405      elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h
    408406       forcing_case2 = .true.
    409407       year_ini_cas=2004
    … …  
    412410       heure_ini_cas=0.
    413411       pdt_cas=1800.         ! forcing frequency
    414       elseif (forcing_type ==105) THEN ! bomex starts 16-12-2004 0h
     412      elseif (forcing_type .eq.105) THEN ! bomex starts 16-12-2004 0h
    415413       forcing_case2 = .true.
    416414       year_ini_cas=1969
    … …  
    419417       heure_ini_cas=0.
    420418       pdt_cas=1800.         ! forcing frequency
    421       elseif (forcing_type ==106) THEN ! ayotte_24SC starts 6-11-1992 0h
     419      elseif (forcing_type .eq.106) THEN ! ayotte_24SC starts 6-11-1992 0h
    422420       forcing_case2 = .true.
    423421       year_ini_cas=1992
    … …  
    426424       heure_ini_cas=10.
    427425       pdt_cas=86400.        ! forcing frequency
    428       elseif (forcing_type ==113) THEN ! Arm_cu starts 21-6-1997 11h30
     426      elseif (forcing_type .eq.113) THEN ! Arm_cu starts 21-6-1997 11h30
    429427       forcing_SCM = .true.
    430428       year_ini_cas=1997
    … …  
    434432       mth_ini_cas=1 ! pour le moment on compte depuis le debut de l'annee
    435433       call getin('time_ini',heure_ini_cas)
    436       elseif (forcing_type ==40) THEN
     434      elseif (forcing_type .eq.40) THEN
    437435       forcing_GCSSold = .true.
    438       elseif (forcing_type ==50) THEN
     436      elseif (forcing_type .eq.50) THEN
    439437       forcing_fire = .true.
    440       elseif (forcing_type ==59) THEN
     438      elseif (forcing_type .eq.59) THEN
    441439       forcing_sandu   = .true.
    442       elseif (forcing_type ==60) THEN
     440      elseif (forcing_type .eq.60) THEN
    443441       forcing_astex   = .true.
    444       elseif (forcing_type ==61) THEN
     442      elseif (forcing_type .eq.61) THEN
    445443       forcing_armcu = .true.
    446        IF(llm/=19.AND.llm/=40) stop 'Erreur nombre de niveaux !!'
     444       IF(llm.NE.19.AND.llm.NE.40) stop 'Erreur nombre de niveaux !!'
    447445      else
    448446       write (*,*) 'ERROR : unknown forcing_type ', forcing_type
    … …  
    463461     jcode = iflag_nudge
    464462     do i = 1,nudge_max
    465        nudge(i) = mod(jcode,10) >= 1
     463       nudge(i) = mod(jcode,10) .ge. 1
    466464       jcode = jcode/10
    467465     enddo
    … …  
    530528
    531529! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
    532       IF(forcing_type == 61) fnday=53100./86400.
    533       IF(forcing_type == 103) fnday=53100./86400.
     530      IF(forcing_type .EQ. 61) fnday=53100./86400.
     531      IF(forcing_type .EQ. 103) fnday=53100./86400.
    534532! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
    535       IF(forcing_type == 6) fnday=64800./86400.
     533      IF(forcing_type .EQ. 6) fnday=64800./86400.
    536534!     IF(forcing_type .EQ. 6) fnday=50400./86400.
    537  IF(forcing_type == 8 ) fnday=129600./86400.
     535 IF(forcing_type .EQ. 8 ) fnday=129600./86400.
    538536      annee_ref = anneeref
    539537      mois = 1
    … …  
    546544      day_end = day_ini + int(fnday)
    547545
    548       IF (forcing_type ==2) THEN
     546      IF (forcing_type .eq.2) THEN
    549547! Convert the initial date of Toga-Coare to Julian day
    550548      call ymds2ju                                                          &
    551549     & (year_ini_toga,mth_ini_toga,day_ini_toga,heure,day_ju_ini_toga)
    552550
    553       ELSEIF (forcing_type ==4) THEN
     551      ELSEIF (forcing_type .eq.4) THEN
    554552! Convert the initial date of TWPICE to Julian day
    555553      call ymds2ju                                                          &
    556554     & (year_ini_twpi,mth_ini_twpi,day_ini_twpi,heure_ini_twpi              &
    557555     & ,day_ju_ini_twpi)
    558       ELSEIF (forcing_type ==6) THEN
     556      ELSEIF (forcing_type .eq.6) THEN
    559557! Convert the initial date of AMMA to Julian day
    560558      call ymds2ju                                                          &
    561559     & (year_ini_amma,mth_ini_amma,day_ini_amma,heure_ini_amma              &
    562560     & ,day_ju_ini_amma)
    563       ELSEIF (forcing_type ==7) THEN
     561      ELSEIF (forcing_type .eq.7) THEN
    564562! Convert the initial date of DICE to Julian day
    565563      call ymds2ju                                                         &
    566564     & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             &
    567565     & ,day_ju_ini_dice)
    568  ELSEIF (forcing_type ==8 ) THEN
     566 ELSEIF (forcing_type .eq.8 ) THEN
    569567! Convert the initial date of GABLS4 to Julian day
    570568      call ymds2ju                                                         &
    571569     & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4     &
    572570     & ,day_ju_ini_gabls4)
    573       ELSEIF (forcing_type >100) THEN
     571      ELSEIF (forcing_type .gt.100) THEN
    574572! Convert the initial date to Julian day
    575573      day_ini_cas=day_deb
    … …  
    579577     & ,day_ju_ini_cas)
    580578      print*,'time case 2',day_ini_cas,day_ju_ini_cas
    581       ELSEIF (forcing_type ==59) THEN
     579      ELSEIF (forcing_type .eq.59) THEN
    582580! Convert the initial date of Sandu case to Julian day
    583581      call ymds2ju                                                          &
    … …  
    585583     &    time_ini*3600.,day_ju_ini_sandu)
    586584
    587       ELSEIF (forcing_type ==60) THEN
     585      ELSEIF (forcing_type .eq.60) THEN
    588586! Convert the initial date of Astex case to Julian day
    589587      call ymds2ju                                                          &
    … …  
    591589     &    time_ini*3600.,day_ju_ini_astex)
    592590
    593       ELSEIF (forcing_type ==61) THEN
     591      ELSEIF (forcing_type .eq.61) THEN
    594592! Convert the initial date of Arm_cu case to Julian day
    595593      call ymds2ju                                                          &
    … …  
    598596      ENDIF
    599597
    600       IF (forcing_type >100) THEN
     598      IF (forcing_type .gt.100) THEN
    601599      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation
    602600      ELSE
    … …  
    640638      call phys_state_var_init(read_climoz)
    641639
    642       if (ngrid/=klon) then
     640      if (ngrid.ne.klon) then
    643641         print*,'stop in inifis'
    644642         print*,'Probleme de dimensions :'
    … …  
    704702      zlay=-rd*300.*log(play/psurf)/rg ! moved after reading profiles
    705703
    706       IF (forcing_type == 59) THEN
     704      IF (forcing_type .eq. 59) THEN
    707705! pour forcing_sandu, on cherche l'indice le plus proche de 700hpa#3000m
    708706      write(*,*) '***********************'
    709707      do l = 1, llm
    710708       write(*,*) 'l,play(l),presnivs(l): ',l,play(l),presnivs(l)
    711        if (trouve_700 .and. play(l)<=70000) then
     709       if (trouve_700 .and. play(l).le.70000) then
    712710         llm700=l
    713711         print *,'llm700,play=',llm700,play(l)/100.
    … …  
    828826        print*,'avant phyredem'
    829827        pctsrf(1,:)=0.
    830           if (nat_surf==0.) then
     828          if (nat_surf.eq.0.) then
    831829          pctsrf(1,is_oce)=1.
    832830          pctsrf(1,is_ter)=0.
    833831          pctsrf(1,is_lic)=0.
    834832          pctsrf(1,is_sic)=0.
    835         else if (nat_surf == 1) then
     833        else if (nat_surf .eq. 1) then
    836834          pctsrf(1,is_oce)=0.
    837835          pctsrf(1,is_ter)=1.
    838836          pctsrf(1,is_lic)=0.
    839837          pctsrf(1,is_sic)=0.
    840         else if (nat_surf == 2) then
     838        else if (nat_surf .eq. 2) then
    841839          pctsrf(1,is_oce)=0.
    842840          pctsrf(1,is_ter)=0.
    843841          pctsrf(1,is_lic)=1.
    844842          pctsrf(1,is_sic)=0.
    845         else if (nat_surf == 3) then
     843        else if (nat_surf .eq. 3) then
    846844          pctsrf(1,is_oce)=0.
    847845          pctsrf(1,is_ter)=0.
    … …  
    872870        pbl_tke(:,2,:)=1.e-2
    873871        PRINT *, ' pbl_tke dans lmdz1d '
    874         if (prt_level >= 5) then
     872        if (prt_level .ge. 5) then
    875873         DO nsrf = 1,4
    876874           PRINT *,'pbl_tke(1,:,',nsrf,') ',pbl_tke(1,:,nsrf)
    … …  
    10231021      endif
    10241022!Al1 ================  end restart =================================
    1025       IF (ecrit_slab_oc==1) then
     1023      IF (ecrit_slab_oc.eq.1) then
    10261024         open(97,file='div_slab.dat',STATUS='UNKNOWN')
    1027        elseif (ecrit_slab_oc==0) then
     1025       elseif (ecrit_slab_oc.eq.0) then
    10281026         open(97,file='div_slab.dat',STATUS='OLD')
    10291027       endif
    … …  
    10481046      it_end = nint(fnday*day_step)
    10491047!test JLD     it_end = 10
    1050       do while(it<=it_end)
    1051 
    1052        if (prt_level>=1) then
     1048      do while(it.le.it_end)
     1049
     1050       if (prt_level.ge.1) then
    10531051         print*,'XXXXXXXXXXXXXXXXXXX ITAP,day,time=',                       &
    10541052     &             it,day,time,it_end,day_step
    … …  
    10561054       endif
    10571055!Al1 demande de restartphy.nc
    1058        if (it==it_end) lastcall=.True.
     1056       if (it.eq.it_end) lastcall=.True.
    10591057
    10601058!---------------------------------------------------------------------
    … …  
    11511149
    11521150       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
    1153      &    .or.forcing_amma .or. forcing_type==101) then
     1151     &    .or.forcing_amma .or. forcing_type.eq.101) then
    11541152         fcoriolis=0.0 ; ug=0. ; vg=0.
    11551153       endif
    … …  
    11661164!on calcule dt_cooling
    11671165        do l=1,llm
    1168         if (play(l)>=20000.) then
     1166        if (play(l).ge.20000.) then
    11691167            dt_cooling(l)=-1.5/86400.
    1170         elseif ((play(l)>=10000.).and.((play(l)<20000.))) then
     1168        elseif ((play(l).ge.10000.).and.((play(l).lt.20000.))) then
    11711169            dt_cooling(l)=-1.5/86400.*(play(l)-10000.)/(10000.)-1./86400.*(20000.-play(l))/10000.*(temp(l)-200.)
    11721170        else
    … …  
    12751273     &               +d_q_nudge(1:mxcalc,:) )
    12761274
    1277         if (prt_level>=3) then
     1275        if (prt_level.ge.3) then
    12781276          print *,                                                          &
    12791277     &    'physiq-> temp(1),dt_phys(1),d_t_adv(1),dt_cooling(1) ',         &
    … …  
    13531351
    13541352!Al1
    1355       if (ecrit_slab_oc/=-1) close(97)
     1353      if (ecrit_slab_oc.ne.-1) close(97)
    13561354
    13571355!Al1 Call to 1D equivalent of dynredem (an,mois,jour,heure ?)
Note: See TracChangeset for help on using the changeset viewer.