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/dyn3d
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/dynetat0.F90

    r5075 r5084  
    88  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    99  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
    10   USE lmdz_netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, &
     10  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, &
    1111                         NF90_CLOSE, NF90_GET_VAR, NF90_NoErr
    1212  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey

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

    r5075 r5084  
    99  USE strings_mod, ONLY: maxlen
    1010  USE infotrac, ONLY: nqtot, tracers
    11   USE lmdz_netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
     11  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
    1212                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER,   &
    1313                    NF90_64BIT_OFFSET
    … …  
    169169  USE infotrac, ONLY: nqtot, tracers, type_trac
    170170  USE control_mod
    171   USE lmdz_netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
     171  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
    172172                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
    173173  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &

  • LMDZ6/trunk/libf/dyn3d/dynredem_mod.F90

    r5075 r5084  
    11MODULE dynredem_mod
    22
    3   USE lmdz_netcdf, ONLY: nf90_strerror,nf90_noerr,nf90_redef,nf90_put_var,nf90_enddef,nf90_put_att,&
    4           nf90_inq_varid,nf90_get_var,nf90_format,nf90_def_var
    5   IMPLICIT NONE; PRIVATE
     3  USE netcdf
     4  PRIVATE
    65  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
    76  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
    … …  
    2019!
    2120!===============================================================================
     21  IMPLICIT NONE
     22!===============================================================================
    2223! Arguments:
    2324  INTEGER,          INTENT(IN) :: ncid
    … …  
    4344!
    4445!===============================================================================
     46  IMPLICIT NONE
     47!===============================================================================
    4548! Arguments:
    4649  INTEGER,          INTENT(IN) :: ncid
    … …  
    6669!
    6770!===============================================================================
     71  IMPLICIT NONE
     72!===============================================================================
    6873! Arguments:
    6974  INTEGER,          INTENT(IN)  :: ncid
    … …  
    8994!
    9095!===============================================================================
     96  IMPLICIT NONE
     97!===============================================================================
    9198! Arguments:
    9299  INTEGER,                    INTENT(IN) :: ncid
    … …  
    95102  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    96103!===============================================================================
    97   CALL err(NF90_DEF_VAR(ncid,var,NF90_FORMAT,did,nvarid),"inq",var)
     104#ifdef NC_DOUBLE
     105  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
     106#else
     107  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
     108#endif
    98109  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
    99110  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
    … …  
    108119SUBROUTINE put_var1(ncid,var,title,did,v,units)
    109120!
     121!===============================================================================
     122  IMPLICIT NONE
    110123!===============================================================================
    111124! Arguments:
    … …  
    132145!
    133146!===============================================================================
     147  IMPLICIT NONE
     148!===============================================================================
    134149! Arguments:
    135150  INTEGER,                    INTENT(IN) :: ncid
    … …  
    154169FUNCTION msg(typ,nam)
    155170!
     171!===============================================================================
     172  IMPLICIT NONE
    156173!===============================================================================
    157174! Arguments:
    … …  
    180197!
    181198!===============================================================================
     199  IMPLICIT NONE
     200!===============================================================================
    182201! Arguments:
    183202  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE

  • LMDZ6/trunk/libf/dyn3d/guide_mod.F90

    r5075 r5084  
    99!=======================================================================
    1010
    11   USE getparam, ONLY: ini_getparam, fin_getparam, getpar
     11  USE getparam, only: ini_getparam, fin_getparam, getpar
    1212  USE Write_Field
    13   USE lmdz_netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
    14           nf90_inq_dimid, nf90_inquire_dimension, nf90_float, nf90_def_var, &
    15           nf_create, nf_def_dim, nf_open, nf_unlimited, nf_write, nf_enddef, nf_redef, &
    16           nf_close, nf_inq_varid, nf90_get_var, nf90_noerr, nf_clobber, &
    17           nf_64bit_offset, nf_inq_dimid, nf_inq_dimlen, nf90_put_var
    18   USE pres2lev_mod, ONLY: pres2lev
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
     15  use pres2lev_mod, only: pres2lev
    1916
    2017  IMPLICIT NONE
    … …  
    7269  SUBROUTINE guide_init
    7370
    74     use lmdz_netcdf, only: nf90_noerr
     71    use netcdf, only: nf90_noerr
    7572    USE control_mod, ONLY: day_step
    7673    USE serre_mod, ONLY: grossismx
    … …  
    8077    INCLUDE "dimensions.h"
    8178    INCLUDE "paramet.h"
     79    INCLUDE "netcdf.inc"
    8280
    8381    INTEGER                :: error,ncidpl,rid,rcod
    … …  
    125123    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
    126124    ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
    127     IF (iguide_sav>0) THEN
     125    IF (iguide_sav.GT.0) THEN
    128126       iguide_sav=day_step/iguide_sav
    129127    ELSE if (iguide_sav == 0) then
    … …  
    145143    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
    146144    CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
    147     IF (iguide_int==0) THEN
     145    IF (iguide_int.EQ.0) THEN
    148146        iguide_int=1
    149     ELSEIF (iguide_int>0) THEN
     147    ELSEIF (iguide_int.GT.0) THEN
    150148        iguide_int=day_step/iguide_int
    151149    ELSE
    … …  
    173171! ---------------------------------------------
    174172    ncidpl=-99
    175     if (guide_plevs==1) then
    176        if (ncidpl==-99) then
     173    if (guide_plevs.EQ.1) then
     174       if (ncidpl.eq.-99) then
    177175          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    178           if (rcod/=NF90_NOERR) THEN
     176          if (rcod.NE.NF90_NOERR) THEN
    179177             abort_message=' Nudging error -> no file apbp.nc'
    180178             CALL abort_gcm(modname,abort_message,1)
    181179          endif
    182180       endif
    183     elseif (guide_plevs==2) then
    184        if (ncidpl==-99) then
     181    elseif (guide_plevs.EQ.2) then
     182       if (ncidpl.EQ.-99) then
    185183          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
    186           if (rcod/=NF90_NOERR) THEN
     184          if (rcod.NE.NF90_NOERR) THEN
    187185             abort_message=' Nudging error -> no file P.nc'
    188186             CALL abort_gcm(modname,abort_message,1)
    … …  
    191189
    192190    elseif (guide_u) then
    193            if (ncidpl==-99) then
     191           if (ncidpl.eq.-99) then
    194192               rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    195                if (rcod/=NF90_NOERR) THEN
     193               if (rcod.NE.NF90_NOERR) THEN
    196194                  CALL abort_gcm(modname, &
    197195                       ' Nudging error -> no file u.nc',1)
    … …  
    200198
    201199    elseif (guide_v) then
    202            if (ncidpl==-99) then
     200           if (ncidpl.eq.-99) then
    203201               rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    204                if (rcod/=NF90_NOERR) THEN
     202               if (rcod.NE.NF90_NOERR) THEN
    205203                  CALL abort_gcm(modname, &
    206204                       ' Nudging error -> no file v.nc',1)
    … …  
    208206           endif
    209207    elseif (guide_T) then
    210            if (ncidpl==-99) then
     208           if (ncidpl.eq.-99) then
    211209               rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    212                if (rcod/=NF90_NOERR) THEN
     210               if (rcod.NE.NF90_NOERR) THEN
    213211                  CALL abort_gcm(modname, &
    214212                       ' Nudging error -> no file T.nc',1)
    … …  
    216214           endif
    217215    elseif (guide_Q) then
    218            if (ncidpl==-99) then
     216           if (ncidpl.eq.-99) then
    219217               rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    220                if (rcod/=NF90_NOERR) THEN
     218               if (rcod.NE.NF90_NOERR) THEN
    221219                  CALL abort_gcm(modname, &
    222220                       ' Nudging error -> no file hur.nc',1)
    … …  
    227225    endif
    228226    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    229     IF (error/=NF90_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    230     IF (error/=NF90_NOERR) THEN
     227    IF (error.NE.NF90_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
     228    IF (error.NE.NF90_NOERR) THEN
    231229        CALL abort_gcm(modname,'Nudging: error reading pressure levels',1)
    232230    ENDIF
    … …  
    308306    ENDIF
    309307
    310     IF (guide_plevs==2) THEN
     308    IF (guide_plevs.EQ.2) THEN
    311309        ALLOCATE(pnat1(iip1,jjp1,nlevnc), stat = error)
    312310        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    316314    ENDIF
    317315
    318     IF (guide_P.OR.guide_plevs==1) THEN
     316    IF (guide_P.OR.guide_plevs.EQ.1) THEN
    319317        ALLOCATE(psnat1(iip1,jjp1), stat = error)
    320318        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    343341    IF (guide_T) tnat1=tnat2
    344342    IF (guide_Q) qnat1=qnat2
    345     IF (guide_plevs==2) pnat1=pnat2
    346     IF (guide_P.OR.guide_plevs==1) psnat1=psnat2
     343    IF (guide_plevs.EQ.2) pnat1=pnat2
     344    IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    347345
    348346  END SUBROUTINE guide_init
    … …  
    442440! Lecture des fichiers de guidage ?
    443441!-----------------------------------------------------------------------
    444     IF (iguide_read/=0) THEN
     442    IF (iguide_read.NE.0) THEN
    445443      ditau=real(itau)
    446444      dday_step=real(day_step)
    447       IF (iguide_read<0) THEN
     445      IF (iguide_read.LT.0) THEN
    448446          tau=ditau/dday_step/REAL(iguide_read)
    449447      ELSE
    … …  
    451449      ENDIF
    452450      reste=tau-AINT(tau)
    453       IF (reste==0.) THEN
    454           IF (itau_test==itau) THEN
     451      IF (reste.EQ.0.) THEN
     452          IF (itau_test.EQ.itau) THEN
    455453            write(lunout,*)trim(modname)//' second pass in advreel at itau=',&
    456454            itau
    … …  
    462460              IF (guide_T) tnat1=tnat2
    463461              IF (guide_Q) qnat1=qnat2
    464               IF (guide_plevs==2) pnat1=pnat2
    465               IF (guide_P.OR.guide_plevs==1) psnat1=psnat2
     462              IF (guide_plevs.EQ.2) pnat1=pnat2
     463              IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    466464              step_rea=step_rea+1
    467465              itau_test=itau
    … …  
    484482! Interpolation et conversion des champs de guidage
    485483!-----------------------------------------------------------------------
    486     IF (MOD(itau,iguide_int)==0) THEN
     484    IF (MOD(itau,iguide_int).EQ.0) THEN
    487485        CALL guide_interp(ps,teta)
    488486    ENDIF
    489487! Repartition entre 2 etats de guidage
    490     IF (iguide_read/=0) THEN
     488    IF (iguide_read.NE.0) THEN
    491489        tau=reste
    492490    ELSE
    … …  
    498496!-----------------------------------------------------------------------
    499497! Sauvegarde du guidage?
    500     f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav)
     498    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    501499    IF (f_out) THEN
    502500      ! compute pressures at layer interfaces
    … …  
    635633        IF (guide_reg) THEN
    636634            DO i=1,iim
    637                 IF (lond(i)<lon_min_g) imin(1)=i
    638                 IF (lond(i)<=lon_max_g) imax(1)=i
     635                IF (lond(i).LT.lon_min_g) imin(1)=i
     636                IF (lond(i).LE.lon_max_g) imax(1)=i
    639637            ENDDO
    640638            lond=rlonv*180./pi
    641639            DO i=1,iim
    642                 IF (lond(i)<lon_min_g) imin(2)=i
    643                 IF (lond(i)<=lon_max_g) imax(2)=i
     640                IF (lond(i).LT.lon_min_g) imin(2)=i
     641                IF (lond(i).LE.lon_max_g) imax(2)=i
    644642            ENDDO
    645643        ENDIF
    … …  
    962960            do j=1,pjm
    963961                do i=1,pim
    964                     if (typ==2) then
     962                    if (typ.eq.2) then
    965963                       zlat=rlatu(j)*180./pi
    966964                       zlon=rlonu(i)*180./pi
    967                     elseif (typ==1) then
     965                    elseif (typ.eq.1) then
    968966                       zlat=rlatu(j)*180./pi
    969967                       zlon=rlonv(i)*180./pi
    970                     elseif (typ==3) then
     968                    elseif (typ.eq.3) then
    971969                       zlat=rlatv(j)*180./pi
    972970                       zlon=rlonv(i)*180./pi
    … …  
    10071005            enddo
    10081006        enddo
    1009         IF (typ==2) THEN
     1007        IF (typ.EQ.2) THEN
    10101008            do j=1,jjp1
    10111009                do i=1,iim
    … …  
    10151013            enddo
    10161014        ENDIF
    1017         IF (typ==3) THEN
     1015        IF (typ.EQ.3) THEN
    10181016            do j=1,jjm
    10191017                do i=1,iip1
    … …  
    10371035            enddo
    10381036            ! Calcul de gamma
    1039             if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
     1037            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    10401038              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
    10411039              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
    … …  
    10441042              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    10451043              write(*,*)trim(modname)//' gamma=',gamma
    1046               if (gamma<1.e-5) then
     1044              if (gamma.lt.1.e-5) then
    10471045                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
    10481046                abort_message='stopped'
    … …  
    10591057        do j=1,pjm
    10601058            do i=1,pim
    1061                 if (typ==1) then
     1059                if (typ.eq.1) then
    10621060                   dxdy_=dxdys(i,j)
    10631061                   zlat=rlatu(j)*180./pi
    1064                 elseif (typ==2) then
     1062                elseif (typ.eq.2) then
    10651063                   dxdy_=dxdyu(i,j)
    10661064                   zlat=rlatu(j)*180./pi
    1067                 elseif (typ==3) then
     1065                elseif (typ.eq.3) then
    10681066                   dxdy_=dxdyv(i,j)
    10691067                   zlat=rlatv(j)*180./pi
    10701068                endif
    1071                 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
     1069                if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    10721070                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
    10731071                    alpha(i,j)=alphamin
    … …  
    10751073                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
    10761074                    xi=min(xi,1.)
    1077                     if(lat_min_g<=zlat .and. zlat<=lat_max_g) then
     1075                    if(lat_min_g.le.zlat .and. zlat.le.lat_max_g) then
    10781076                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
    10791077                    else
    … …  
    10911089!=======================================================================
    10921090  SUBROUTINE guide_read(timestep)
     1091
     1092    use netcdf, only: NF90_GET_VAR, nf90_noerr
     1093
    10931094    IMPLICIT NONE
    10941095
    … …  
    11171118         write(*,*) trim(modname)//': opening nudging files '
    11181119! Niveaux de pression si non constants
    1119          if (guide_plevs==1) then
     1120         if (guide_plevs.EQ.1) then
    11201121             write(*,*) trim(modname)//' Reading nudging on model levels'
    11211122             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1122              IF (rcode/=NF90_NOERR) THEN
     1123             IF (rcode.NE.NF90_NOERR) THEN
    11231124              abort_message='Nudging: error -> no file apbp.nc'
    11241125              CALL abort_gcm(modname,abort_message,1)
    11251126             ENDIF
    11261127             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1127              IF (rcode/=NF90_NOERR) THEN
     1128             IF (rcode.NE.NF90_NOERR) THEN
    11281129              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    11291130              CALL abort_gcm(modname,abort_message,1)
    11301131             ENDIF
    11311132             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1132              IF (rcode/=NF90_NOERR) THEN
     1133             IF (rcode.NE.NF90_NOERR) THEN
    11331134              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    11341135              CALL abort_gcm(modname,abort_message,1)
    … …  
    11381139
    11391140! Pression si guidage sur niveaux P variables
    1140          if (guide_plevs==2) then
     1141         if (guide_plevs.EQ.2) then
    11411142             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1142              IF (rcode/=NF90_NOERR) THEN
     1143             IF (rcode.NE.NF90_NOERR) THEN
    11431144              abort_message='Nudging: error -> no file P.nc'
    11441145              CALL abort_gcm(modname,abort_message,1)
    11451146             ENDIF
    11461147             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1147              IF (rcode/=NF90_NOERR) THEN
     1148             IF (rcode.NE.NF90_NOERR) THEN
    11481149              abort_message='Nudging: error -> no PRES variable in file P.nc'
    11491150              CALL abort_gcm(modname,abort_message,1)
    11501151             ENDIF
    11511152             write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
    1152              if (ncidpl==-99) ncidpl=ncidp
     1153             if (ncidpl.eq.-99) ncidpl=ncidp
    11531154         endif
    11541155
    … …  
    11561157         if (guide_u) then
    11571158             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1158              IF (rcode/=NF90_NOERR) THEN
     1159             IF (rcode.NE.NF90_NOERR) THEN
    11591160              abort_message='Nudging: error -> no file u.nc'
    11601161              CALL abort_gcm(modname,abort_message,1)
    11611162             ENDIF
    11621163             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1163              IF (rcode/=NF90_NOERR) THEN
     1164             IF (rcode.NE.NF90_NOERR) THEN
    11641165              abort_message='Nudging: error -> no UWND variable in file u.nc'
    11651166              CALL abort_gcm(modname,abort_message,1)
    11661167             ENDIF
    11671168             write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
    1168              if (ncidpl==-99) ncidpl=ncidu
     1169             if (ncidpl.eq.-99) ncidpl=ncidu
    11691170
    11701171             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
    11711172             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    1172              IF (lendim /= iip1) THEN
     1173             IF (lendim .NE. iip1) THEN
    11731174                abort_message='dimension LONU different from iip1 in u.nc'
    11741175                CALL abort_gcm(modname,abort_message,1)
    … …  
    11771178             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
    11781179             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    1179              IF (lendim /= jjp1) THEN
     1180             IF (lendim .NE. jjp1) THEN
    11801181                abort_message='dimension LATU different from jjp1 in u.nc'
    11811182                CALL abort_gcm(modname,abort_message,1)
    … …  
    11871188         if (guide_v) then
    11881189             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1189              IF (rcode/=NF90_NOERR) THEN
     1190             IF (rcode.NE.NF90_NOERR) THEN
    11901191              abort_message='Nudging: error -> no file v.nc'
    11911192              CALL abort_gcm(modname,abort_message,1)
    11921193             ENDIF
    11931194             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1194              IF (rcode/=NF90_NOERR) THEN
     1195             IF (rcode.NE.NF90_NOERR) THEN
    11951196              abort_message='Nudging: error -> no VWND variable in file v.nc'
    11961197              CALL abort_gcm(modname,abort_message,1)
    11971198             ENDIF
    11981199             write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
    1199              if (ncidpl==-99) ncidpl=ncidv
     1200             if (ncidpl.eq.-99) ncidpl=ncidv
    12001201             
    12011202             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
    12021203             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
    12031204             
    1204                 IF (lendim /= iip1) THEN
     1205                IF (lendim .NE. iip1) THEN
    12051206                abort_message='dimension LONV different from iip1 in v.nc'
    12061207                CALL abort_gcm(modname,abort_message,1)
    … …  
    12101211             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
    12111212             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
    1212              IF (lendim /= jjm) THEN
     1213             IF (lendim .NE. jjm) THEN
    12131214                abort_message='dimension LATV different from jjm in v.nc'
    12141215                CALL abort_gcm(modname,abort_message,1)
    … …  
    12201221         if (guide_T) then
    12211222             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1222              IF (rcode/=NF90_NOERR) THEN
     1223             IF (rcode.NE.NF90_NOERR) THEN
    12231224              abort_message='Nudging: error -> no file T.nc'
    12241225              CALL abort_gcm(modname,abort_message,1)
    12251226             ENDIF
    12261227             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1227              IF (rcode/=NF90_NOERR) THEN
     1228             IF (rcode.NE.NF90_NOERR) THEN
    12281229              abort_message='Nudging: error -> no AIR variable in file T.nc'
    12291230              CALL abort_gcm(modname,abort_message,1)
    12301231             ENDIF
    12311232             write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
    1232              if (ncidpl==-99) ncidpl=ncidt
     1233             if (ncidpl.eq.-99) ncidpl=ncidt
    12331234
    12341235             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
    12351236             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    1236              IF (lendim /= iip1) THEN
     1237             IF (lendim .NE. iip1) THEN
    12371238                abort_message='dimension LONV different from iip1 in T.nc'
    12381239                CALL abort_gcm(modname,abort_message,1)
    … …  
    12411242             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
    12421243             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    1243              IF (lendim /= jjp1) THEN
     1244             IF (lendim .NE. jjp1) THEN
    12441245                abort_message='dimension LATU different from jjp1 in T.nc'
    12451246                CALL abort_gcm(modname,abort_message,1)
    … …  
    12511252         if (guide_Q) then
    12521253             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1253              IF (rcode/=NF90_NOERR) THEN
     1254             IF (rcode.NE.NF90_NOERR) THEN
    12541255              abort_message='Nudging: error -> no file hur.nc'
    12551256              CALL abort_gcm(modname,abort_message,1)
    12561257             ENDIF
    12571258             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1258              IF (rcode/=NF90_NOERR) THEN
     1259             IF (rcode.NE.NF90_NOERR) THEN
    12591260              abort_message='Nudging: error -> no RH variable in file hur.nc'
    12601261              CALL abort_gcm(modname,abort_message,1)
    12611262             ENDIF
    12621263             write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    1263              if (ncidpl==-99) ncidpl=ncidQ
     1264             if (ncidpl.eq.-99) ncidpl=ncidQ
    12641265
    12651266             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
    12661267             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    1267              IF (lendim /= iip1) THEN
     1268             IF (lendim .NE. iip1) THEN
    12681269                abort_message='dimension LONV different from iip1 in hur.nc'
    12691270                CALL abort_gcm(modname,abort_message,1)
    … …  
    12721273             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
    12731274             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    1274              IF (lendim /= jjp1) THEN
     1275             IF (lendim .NE. jjp1) THEN
    12751276                abort_message='dimension LATU different from jjp1 in hur.nc'
    12761277                CALL abort_gcm(modname,abort_message,1)
    … …  
    12821283         if ((guide_P).OR.(guide_modele)) then
    12831284             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1284              IF (rcode/=NF90_NOERR) THEN
     1285             IF (rcode.NE.NF90_NOERR) THEN
    12851286              abort_message='Nudging: error -> no file ps.nc'
    12861287              CALL abort_gcm(modname,abort_message,1)
    12871288             ENDIF
    12881289             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1289              IF (rcode/=NF90_NOERR) THEN
     1290             IF (rcode.NE.NF90_NOERR) THEN
    12901291              abort_message='Nudging: error -> no SP variable in file ps.nc'
    12911292              CALL abort_gcm(modname,abort_message,1)
    … …  
    12941295         endif
    12951296! Coordonnee verticale
    1296          if (guide_plevs==0) then
     1297         if (guide_plevs.EQ.0) then
    12971298              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1298               IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     1299              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    12991300              write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    13001301         endif
    13011302! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1302          if (guide_plevs==1) then
     1303         if (guide_plevs.EQ.1) then
    13031304             status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc])
    13041305             status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc])
    1305          ELSEIF (guide_plevs==0) THEN
     1306         ELSEIF (guide_plevs.EQ.0) THEN
    13061307             status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc])
    13071308!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
    … …  
    13281329
    13291330! Pression
    1330      if (guide_plevs==2) then
     1331     if (guide_plevs.EQ.2) then
    13311332         status=NF90_GET_VAR(ncidp,varidp,pnat2,start,count)
    13321333         IF (invert_y) THEN
    … …  
    13881389!=======================================================================
    13891390  SUBROUTINE guide_read2D(timestep)
     1391
     1392    use netcdf, only: nf90_get_var, nf90_noerr
     1393
    13901394    IMPLICIT NONE
    13911395
    … …  
    14171421         write(*,*)trim(modname)//' : opening nudging files '
    14181422! Ap et Bp si niveaux de pression hybrides
    1419          if (guide_plevs==1) then
     1423         if (guide_plevs.EQ.1) then
    14201424           write(*,*)trim(modname)//' Reading nudging on model levels'
    14211425           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1422            IF (rcode/=NF90_NOERR) THEN
     1426           IF (rcode.NE.NF90_NOERR) THEN
    14231427             abort_message='Nudging: error -> no file apbp.nc'
    14241428           CALL abort_gcm(modname,abort_message,1)
    14251429           ENDIF
    14261430           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1427            IF (rcode/=NF90_NOERR) THEN
     1431           IF (rcode.NE.NF90_NOERR) THEN
    14281432             abort_message='Nudging: error -> no AP variable in file apbp.nc'
    14291433           CALL abort_gcm(modname,abort_message,1)
    14301434           ENDIF
    14311435           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1432            IF (rcode/=NF90_NOERR) THEN
     1436           IF (rcode.NE.NF90_NOERR) THEN
    14331437             abort_message='Nudging: error -> no BP variable in file apbp.nc'
    14341438             CALL abort_gcm(modname,abort_message,1)
    … …  
    14371441         endif
    14381442! Pression
    1439          if (guide_plevs==2) then
     1443         if (guide_plevs.EQ.2) then
    14401444           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1441            IF (rcode/=NF90_NOERR) THEN
     1445           IF (rcode.NE.NF90_NOERR) THEN
    14421446             abort_message='Nudging: error -> no file P.nc'
    14431447             CALL abort_gcm(modname,abort_message,1)
    14441448           ENDIF
    14451449           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1446            IF (rcode/=NF90_NOERR) THEN
     1450           IF (rcode.NE.NF90_NOERR) THEN
    14471451             abort_message='Nudging: error -> no PRES variable in file P.nc'
    14481452             CALL abort_gcm(modname,abort_message,1)
    14491453           ENDIF
    14501454           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
    1451            if (ncidpl==-99) ncidpl=ncidp
     1455           if (ncidpl.eq.-99) ncidpl=ncidp
    14521456         endif
    14531457! Vent zonal
    14541458         if (guide_u) then
    14551459           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1456            IF (rcode/=NF90_NOERR) THEN
     1460           IF (rcode.NE.NF90_NOERR) THEN
    14571461             abort_message='Nudging: error -> no file u.nc'
    14581462             CALL abort_gcm(modname,abort_message,1)
    14591463           ENDIF
    14601464           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1461            IF (rcode/=NF90_NOERR) THEN
     1465           IF (rcode.NE.NF90_NOERR) THEN
    14621466             abort_message='Nudging: error -> no UWND variable in file u.nc'
    14631467             CALL abort_gcm(modname,abort_message,1)
    14641468           ENDIF
    14651469           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
    1466            if (ncidpl==-99) ncidpl=ncidu
     1470           if (ncidpl.eq.-99) ncidpl=ncidu
    14671471         endif
    14681472! Vent meridien
    14691473         if (guide_v) then
    14701474           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1471            IF (rcode/=NF90_NOERR) THEN
     1475           IF (rcode.NE.NF90_NOERR) THEN
    14721476             abort_message='Nudging: error -> no file v.nc'
    14731477             CALL abort_gcm(modname,abort_message,1)
    14741478           ENDIF
    14751479           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1476            IF (rcode/=NF90_NOERR) THEN
     1480           IF (rcode.NE.NF90_NOERR) THEN
    14771481             abort_message='Nudging: error -> no VWND variable in file v.nc'
    14781482             CALL abort_gcm(modname,abort_message,1)
    14791483           ENDIF
    14801484           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
    1481            if (ncidpl==-99) ncidpl=ncidv
     1485           if (ncidpl.eq.-99) ncidpl=ncidv
    14821486         endif
    14831487! Temperature
    14841488         if (guide_T) then
    14851489           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1486            IF (rcode/=NF90_NOERR) THEN
     1490           IF (rcode.NE.NF90_NOERR) THEN
    14871491             abort_message='Nudging: error -> no file T.nc'
    14881492             CALL abort_gcm(modname,abort_message,1)
    14891493           ENDIF
    14901494           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1491            IF (rcode/=NF90_NOERR) THEN
     1495           IF (rcode.NE.NF90_NOERR) THEN
    14921496             abort_message='Nudging: error -> no AIR variable in file T.nc'
    14931497             CALL abort_gcm(modname,abort_message,1)
    14941498           ENDIF
    14951499           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
    1496            if (ncidpl==-99) ncidpl=ncidt
     1500           if (ncidpl.eq.-99) ncidpl=ncidt
    14971501         endif
    14981502! Humidite
    14991503         if (guide_Q) then
    15001504           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1501            IF (rcode/=NF90_NOERR) THEN
     1505           IF (rcode.NE.NF90_NOERR) THEN
    15021506             abort_message='Nudging: error -> no file hur.nc'
    15031507             CALL abort_gcm(modname,abort_message,1)
    15041508           ENDIF
    15051509           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1506            IF (rcode/=NF90_NOERR) THEN
     1510           IF (rcode.NE.NF90_NOERR) THEN
    15071511             abort_message='Nudging: error -> no RH,variable in file hur.nc'
    15081512             CALL abort_gcm(modname,abort_message,1)
    15091513           ENDIF
    15101514           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    1511            if (ncidpl==-99) ncidpl=ncidQ
     1515           if (ncidpl.eq.-99) ncidpl=ncidQ
    15121516         endif
    15131517! Pression de surface
    15141518         if ((guide_P).OR.(guide_modele)) then
    15151519           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1516            IF (rcode/=NF90_NOERR) THEN
     1520           IF (rcode.NE.NF90_NOERR) THEN
    15171521             abort_message='Nudging: error -> no file ps.nc'
    15181522             CALL abort_gcm(modname,abort_message,1)
    15191523           ENDIF
    15201524           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1521            IF (rcode/=NF90_NOERR) THEN
     1525           IF (rcode.NE.NF90_NOERR) THEN
    15221526             abort_message='Nudging: error -> no SP variable in file ps.nc'
    15231527             CALL abort_gcm(modname,abort_message,1)
    … …  
    15261530         endif
    15271531! Coordonnee verticale
    1528          if (guide_plevs==0) then
     1532         if (guide_plevs.EQ.0) then
    15291533           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1530            IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     1534           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    15311535           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    15321536         endif
    15331537! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1534          if (guide_plevs==1) then
     1538         if (guide_plevs.EQ.1) then
    15351539             status=NF90_GET_VAR(ncidpl,varidap,apnc,[1],[nlevnc])
    15361540             status=NF90_GET_VAR(ncidpl,varidbp,bpnc,[1],[nlevnc])
    1537          elseif (guide_plevs==0) THEN
     1541         elseif (guide_plevs.EQ.0) THEN
    15381542             status=NF90_GET_VAR(ncidpl,varidpl,apnc,[1],[nlevnc])
    15391543             apnc=apnc*100.! conversion en Pascals
    … …  
    15591563
    15601564!  Pression
    1561      if (guide_plevs==2) then
     1565     if (guide_plevs.EQ.2) then
    15621566         status=NF90_GET_VAR(ncidp,varidp,zu,start,count)
    15631567         DO i=1,iip1
    … …  
    16251629
    16261630!  Pression de surface
    1627      if ((guide_P).OR.(guide_plevs==1))  then
     1631     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    16281632         start(3)=timestep
    16291633         start(4)=0
    … …  
    16491653    USE comconst_mod, ONLY: pi
    16501654    USE comvert_mod, ONLY: presnivs
    1651     USE netcdf95, ONLY: nf95_def_var, nf95_put_var
    1652 
     1655    use netcdf95, only: nf95_def_var, nf95_put_var
     1656    use netcdf, only: nf90_float, nf90_def_var
     1657   
    16531658    IMPLICIT NONE
    16541659
    16551660    INCLUDE "dimensions.h"
    16561661    INCLUDE "paramet.h"
     1662    INCLUDE "netcdf.inc"
    16571663    INCLUDE "comgeom2.h"
    16581664   
    … …  
    16751681
    16761682    write(*,*)trim(modname)//': output timestep',timestep,'var ',varname
    1677     IF (timestep==0) THEN
     1683    IF (timestep.EQ.0) THEN
    16781684! ----------------------------------------------
    16791685! initialisation fichier de sortie
    … …  
    17071713
    17081714! Enregistrement des variables dimensions
    1709         ierr = nf90_put_var(nid,vid_lonu,rlonu*180./pi)
    1710         ierr = nf90_put_var(nid,vid_lonv,rlonv*180./pi)
    1711         ierr = nf90_put_var(nid,vid_latu,rlatu*180./pi)
    1712         ierr = nf90_put_var(nid,vid_latv,rlatv*180./pi)
    1713         ierr = nf90_put_var(nid,vid_lev,presnivs)
    1714         ierr = nf90_put_var(nid,vid_cu,cu)
    1715         ierr = nf90_put_var(nid,vid_cv,cv)
    1716         ierr = nf90_put_var(nid,vid_au,alpha_u)
    1717         ierr = nf90_put_var(nid,vid_av,alpha_v)
     1715#ifdef NC_DOUBLE
     1716        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
     1717        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
     1718        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi)
     1719        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi)
     1720        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs)
     1721        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
     1722        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     1723        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,alpha_u)
     1724        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,alpha_v)
     1725#else
     1726        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
     1727        ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi)
     1728        ierr = NF_PUT_VAR_REAL(nid,vid_latu,rlatu*180./pi)
     1729        ierr = NF_PUT_VAR_REAL(nid,vid_latv,rlatv*180./pi)
     1730        ierr = NF_PUT_VAR_REAL(nid,vid_lev,presnivs)
     1731        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
     1732        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     1733        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     1734        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
     1735#endif
    17181736        call nf95_put_var(nid, varid_alpha_t, alpha_t)
    17191737        call nf95_put_var(nid, varid_alpha_q, alpha_q)
    … …  
    17891807    END SELECT
    17901808
    1791     ierr = nf90_put_var(nid,varid,field2,start,count)
     1809
     1810#ifdef NC_DOUBLE
     1811    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field2)
     1812#else
     1813    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field2)
     1814#endif
     1815
    17921816    ierr = NF_CLOSE(nid)
    17931817
    … …  
    18041828    do l=1,nl
    18051829        do i=2,iim-1
    1806             if(abs(x(i,l))>1.e10) then
     1830            if(abs(x(i,l)).gt.1.e10) then
    18071831               zz=0.5*(x(i-1,l)+x(i+1,l))
    18081832              print*,'correction ',i,l,x(i,l),zz

  • LMDZ6/trunk/libf/dyn3d/iniacademic.F90

    r5075 r5084  
    2222  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    2323  USE readTracFiles_mod, ONLY: addPhase
    24   use lmdz_netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID,NF90_CLOSE,NF90_GET_VAR
     24  use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID
     25  use netcdf, only : NF90_CLOSE, NF90_GET_VAR
     26
    2527
    2628  !   Author:    Frederic Hourdin      original: 15/01/93
    … …  
    141143     relief=0.
    142144     ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)
    143      if (ierr==NF90_NOERR) THEN
     145     if (ierr.EQ.NF90_NOERR) THEN
    144146         ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid)
    145147         if (ierr==NF90_NOERR) THEN
    … …  
    246248        tetastrat=ttp*zsig**(-kappa)
    247249        tetapv=tetastrat
    248         IF ((ok_pv).AND.(zsig<0.1)) THEN
     250        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
    249251           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
    250252        ENDIF
Note: See TracChangeset for help on using the changeset viewer.