Changeset 5084


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
Files:
6 deleted
129 edited
4 copied

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/arch/arch-X64_ADASTRA-GNU.fcm

    r5066 r5084  
    99%FPP_DEF             NC_DOUBLE
    1010
    11 %BASE_FFLAGS         -ffree-line-length-0 -fdefault-real-8 -fallow-argument-mismatch -fimplicit-none -march=native -fPIC
     11%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none -march=native -fPIC
    1212%BASE_CFLAGS         -w -std=c++11 -D__XIOS_EXCEPTION  # xios
    1313# /!\ LD must be written in Makefile syntax

  • LMDZ6/trunk/arch/arch-X64_ADASTRA-GNU.path

    r5066 r5084  
    1 NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"  # nc required for xios
     1NETCDF_INCDIR="-I$(nf-config --includedir) -I$(nc-config --includedir)"
    22# Ugly hack for orchidee <=2.0
    33NETCDF_LIBDIR="-L${NETCDF_DIR}/lib" # for some reason on adastra `nf-config --flibs` is empty
    4 NETCDF_LIB="-lnetcdff -lnetcdf"
     4NETCDF_LIB="-lnetcdf -lnetcdff"  # same as above
    55NETCDF95_INCDIR="-I$(pwd)/../../include"
    66NETCDF95_LIBDIR="-L$(pwd)/../../lib"

  • LMDZ6/trunk/arch/arch-local-gfortran-parallel.fcm

    r5066 r5084  
    99%FPP_DEF             NC_DOUBLE
    1010
    11 %BASE_FFLAGS         -ffree-line-length-0 -fdefault-real-8 -fallow-argument-mismatch -fimplicit-none
     11%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none
    1212%BASE_CFLAGS         -w -std=c++11 -D__XIOS_EXCEPTION  # xios
    1313# /!\ LD must be written in Makefile syntax
    … …  
    1515%BASE_INC            -D__NONE__  # xios
    1616
    17 %PROD_FFLAGS         -O3 -march=native -fPIC
     17%PROD_FFLAGS         -O3 -march=native
    1818%PROD_CFLAGS         -O3 -DBOOST_DISABLE_ASSERTS  # xios
    1919
    … …  
    3030
    3131%CPP                 cpp  # xios
     32
     33

  • LMDZ6/trunk/arch/arch-local-gfortran.fcm

    r5066 r5084  
    77%FPP_FLAGS           -P -traditional
    88%FPP_DEF             NC_DOUBLE
    9 %BASE_FFLAGS         -ffree-line-length-0 -fdefault-real-8 -fallow-argument-mismatch -fimplicit-none
     9%BASE_FFLAGS         -cpp -ffree-line-length-0 -fdefault-real-8 -DNC_DOUBLE -fallow-argument-mismatch -fimplicit-none
    1010%PROD_FFLAGS         -O3 -march=native
    1111%DEV_FFLAGS          -Wall -fbounds-check

  • 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

  • LMDZ6/trunk/libf/dyn3d_common/advx.F

    r5077 r5084  
    9595
    9696C  -------------------------------------
    97       DO j = 1,jjp1
     97      DO 300 j = 1,jjp1
    9898         NUM(j) = 1
    99       END DO
     99  300 CONTINUE
    100100      sqi = 0.
    101101      sqf = 0.
    … …  
    121121C  ugri est en kg/s
    122122
    123       DO l = 1,llm
    124          DO j = 1,jjm+1
    125             DO i = 1,iip1
     123      DO 500 l = 1,llm
     124         DO 500 j = 1,jjm+1
     125            DO 500 i = 1,iip1 
    126126C            ugri (i,j,llm+1-l) = pbaru (i,j,l) * ( dsig(l) / g )
    127127             ugri (i,j,llm+1-l) = pbaru (i,j,l)
    128       END DO
    129       END DO
    130       END DO
     128  500 CONTINUE
    131129
    132130
    … …  
    139137C  boucle principale sur les niveaux et les latitudes
    140138C
    141       DO L=1,NIV
    142       DO K=lati,latf
     139      DO 1 L=1,NIV
     140      DO 1 K=lati,latf
    143141C
    144142C  initialisation
    … …  
    146144C  program assumes periodic boundaries in X
    147145C
    148       DO I=2,LON
     146      DO 10 I=2,LON
    149147         SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
    150       END DO
     148 10   CONTINUE
    151149      SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
    152150C
    … …  
    156154      LONK=LON/NUMK
    157155C
    158       IF(NUMK>1) THEN
    159 C
    160       DO I=1,LON
     156      IF(NUMK.GT.1) THEN
     157C
     158      DO 111 I=1,LON
    161159         TM(I)=0.
    162       END DO
    163       DO JV=1,NTRA
    164       DO I=1,LON
     160 111  CONTINUE
     161      DO 112 JV=1,NTRA
     162      DO 1120 I=1,LON
    165163         T0(I,JV)=0.
    166164         TX(I,JV)=0.
    167165         TY(I,JV)=0.
    168166         TZ(I,JV)=0.
    169       END DO
    170       END DO
    171 C
    172       DO I2=1,NUMK
    173 C
    174          DO I=1,LONK
     167 1120 CONTINUE
     168 112  CONTINUE
     169C
     170      DO 11 I2=1,NUMK
     171C
     172         DO 113 I=1,LONK
    175173            I3=(I-1)*NUMK+I2
    176174            TM(I)=TM(I)+SM(I3,K,L)
    177175            ALF(I)=SM(I3,K,L)/TM(I)
    178176            ALF1(I)=1.-ALF(I)
    179       END DO
     177 113     CONTINUE
    180178C
    181179         DO  JV=1,NTRA
    … …  
    192190         ENDDO
    193191C
    194       END DO
     192 11   CONTINUE
    195193C
    196194      ELSE
    197195C
    198       DO I=1,LON
     196      DO 115 I=1,LON
    199197         TM(I)=SM(I,K,L)
    200       END DO
    201       DO JV=1,NTRA
    202       DO I=1,LON
     198 115  CONTINUE
     199      DO 116 JV=1,NTRA
     200      DO 1160 I=1,LON
    203201         T0(I,JV)=S0(I,K,L,JV)
    204202         TX(I,JV)=sx(I,K,L,JV)
    205203         TY(I,JV)=sy(I,K,L,JV)
    206204         TZ(I,JV)=sz(I,K,L,JV)
    207       END DO
    208       END DO
    209 C
    210       ENDIF
    211 C
    212       DO I=1,LONK
     205 1160 CONTINUE
     206 116  CONTINUE
     207C
     208      ENDIF
     209C
     210      DO 117 I=1,LONK
    213211         UEXT(I)=UGRI(I*NUMK,K,L)
    214       END DO
     212 117  CONTINUE
    215213C
    216214C  place limits on appropriate moments before transport
    … …  
    219217      IF(.NOT.LIMIT) GO TO 13
    220218C
    221       DO JV=1,NTRA
    222       DO I=1,LONK
     219      DO 12 JV=1,NTRA
     220      DO 120 I=1,LONK
    223221        TX(I,JV)=SIGN(AMIN1(AMAX1(T0(I,JV),0.),ABS(TX(I,JV))),TX(I,JV))
    224       END DO
    225       END DO
     222 120  CONTINUE
     223 12   CONTINUE
    226224C
    227225 13   CONTINUE
    … …  
    233231C  flux from IP to I if U(I).lt.0
    234232C
    235       DO I=1,LONK-1
    236          IF(UEXT(I)<0.) THEN
     233      DO 140 I=1,LONK-1
     234         IF(UEXT(I).LT.0.) THEN
    237235           FM(I)=-UEXT(I)*DTX
    238236           ALF(I)=FM(I)/TM(I+1)
    239237           TM(I+1)=TM(I+1)-FM(I)
    240238         ENDIF
    241       END DO
     239 140  CONTINUE
    242240C
    243241      I=LONK
    244       IF(UEXT(I)<0.) THEN
     242      IF(UEXT(I).LT.0.) THEN
    245243        FM(I)=-UEXT(I)*DTX
    246244        ALF(I)=FM(I)/TM(1)
    … …  
    250248C  flux from I to IP if U(I).gt.0
    251249C
    252       DO I=1,LONK
    253          IF(UEXT(I)>=0.) THEN
     250      DO 141 I=1,LONK
     251         IF(UEXT(I).GE.0.) THEN
    254252           FM(I)=UEXT(I)*DTX
    255253           ALF(I)=FM(I)/TM(I)
    256254           TM(I)=TM(I)-FM(I)
    257255         ENDIF
    258       END DO
    259 C
    260       DO I=1,LONK
     256 141  CONTINUE
     257C
     258      DO 142 I=1,LONK
    261259         ALFQ(I)=ALF(I)*ALF(I)
    262260         ALF1(I)=1.-ALF(I)
    263261         ALF1Q(I)=ALF1(I)*ALF1(I)
    264       END DO
    265 C
    266       DO JV=1,NTRA
    267       DO I=1,LONK-1
    268 C
    269          IF(UEXT(I)<0.) THEN
     262 142  CONTINUE
     263C
     264      DO 150 JV=1,NTRA
     265      DO 1500 I=1,LONK-1
     266C
     267         IF(UEXT(I).LT.0.) THEN
    270268C
    271269           F0(I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*TX(I+1,JV) )
    … …  
    281279         ENDIF
    282280C
    283       END DO
    284       END DO
     281 1500 CONTINUE
     282 150  CONTINUE
    285283C
    286284      I=LONK
    287       IF(UEXT(I)<0.) THEN
    288 C
    289         DO JV=1,NTRA
     285      IF(UEXT(I).LT.0.) THEN
     286C
     287        DO 151 JV=1,NTRA
    290288C
    291289           F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*TX(1,JV) )
    … …  
    299297           TZ(1,JV)=TZ(1,JV)-FZ(I,JV)
    300298C
    301       END DO
    302 C
    303       ENDIF
    304 C
    305       DO JV=1,NTRA
    306       DO I=1,LONK
    307 C
    308          IF(UEXT(I)>=0.) THEN
     299 151    CONTINUE
     300C
     301      ENDIF
     302C
     303      DO 152 JV=1,NTRA
     304      DO 1520 I=1,LONK
     305C
     306         IF(UEXT(I).GE.0.) THEN
    309307C
    310308           F0(I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*TX(I,JV) )
    … …  
    320318         ENDIF
    321319C
    322       END DO
    323       END DO
     320 1520 CONTINUE
     321 152  CONTINUE
    324322C
    325323C  puts the temporary moments Fi into appropriate neighboring boxes
    326324C
    327       DO I=1,LONK
    328          IF(UEXT(I)<0.) THEN
     325      DO 160 I=1,LONK
     326         IF(UEXT(I).LT.0.) THEN
    329327           TM(I)=TM(I)+FM(I)
    330328           ALF(I)=FM(I)/TM(I)
    331329         ENDIF
    332       END DO
    333 C
    334       DO I=1,LONK-1
    335          IF(UEXT(I)>=0.) THEN
     330 160  CONTINUE
     331C
     332      DO 161 I=1,LONK-1
     333         IF(UEXT(I).GE.0.) THEN
    336334           TM(I+1)=TM(I+1)+FM(I)
    337335           ALF(I)=FM(I)/TM(I+1)
    338336         ENDIF
    339       END DO
     337 161  CONTINUE
    340338C
    341339      I=LONK
    342       IF(UEXT(I)>=0.) THEN
     340      IF(UEXT(I).GE.0.) THEN
    343341        TM(1)=TM(1)+FM(I)
    344342        ALF(I)=FM(I)/TM(1)
    345343      ENDIF
    346344C
    347       DO I=1,LONK
     345      DO 162 I=1,LONK
    348346         ALF1(I)=1.-ALF(I)
    349       END DO
    350 C
    351       DO JV=1,NTRA
    352       DO I=1,LONK
    353 C
    354          IF(UEXT(I)<0.) THEN
     347 162  CONTINUE
     348C
     349      DO 170 JV=1,NTRA
     350      DO 1700 I=1,LONK
     351C
     352         IF(UEXT(I).LT.0.) THEN
    355353C
    356354           TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
    … …  
    362360         ENDIF
    363361C
    364       END DO
    365       END DO
    366 C
    367       DO JV=1,NTRA
    368       DO I=1,LONK-1
    369 C
    370          IF(UEXT(I)>=0.) THEN
     362 1700 CONTINUE
     363 170  CONTINUE
     364C
     365      DO 171 JV=1,NTRA
     366      DO 1710 I=1,LONK-1
     367C
     368         IF(UEXT(I).GE.0.) THEN
    371369C
    372370           TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
    … …  
    378376         ENDIF
    379377C
    380       END DO
    381       END DO
     378 1710 CONTINUE
     379 171  CONTINUE
    382380C
    383381      I=LONK
    384       IF(UEXT(I)>=0.) THEN
    385         DO JV=1,NTRA
     382      IF(UEXT(I).GE.0.) THEN
     383        DO 172 JV=1,NTRA
    386384           TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
    387385           T0(1,JV)=T0(1,JV)+F0(I,JV)
    … …  
    389387           TY(1,JV)=TY(1,JV)+FY(I,JV)
    390388           TZ(1,JV)=TZ(1,JV)+FZ(I,JV)
    391       END DO
     389 172    CONTINUE
    392390      ENDIF
    393391C
    394392C  retour aux mailles d'origine (passage des Tij aux Sij)
    395393C
    396       IF(NUMK>1) THEN
    397 C
    398       DO I2=1,NUMK
    399 C
    400          DO I=1,LONK
     394      IF(NUMK.GT.1) THEN
     395C
     396      DO 180 I2=1,NUMK
     397C
     398         DO 180 I=1,LONK
    401399C
    402400            I3=I2+(I-1)*NUMK
    … …  
    409407            ALF1Q(I)=ALF1(I)*ALF1(I)
    410408C
    411       END DO
    412       END DO
     409 180     CONTINUE
    413410C
    414411         DO  JV=1,NTRA
    … …  
    434431      ELSE
    435432C
    436       DO I=1,LON
     433      DO 190 I=1,LON
    437434         SM(I,K,L)=TM(I)
    438       END DO
    439       DO JV=1,NTRA
    440       DO I=1,LON
     435 190  CONTINUE
     436      DO 191 JV=1,NTRA
     437      DO 1910 I=1,LON
    441438         S0(I,K,L,JV)=T0(I,JV)
    442439         sx(I,K,L,JV)=TX(I,JV)
    443440         sy(I,K,L,JV)=TY(I,JV)
    444441         sz(I,K,L,JV)=TZ(I,JV)
    445       END DO
    446       END DO
    447 C
    448       ENDIF
    449 C
    450       END DO
    451       END DO
     442 1910 CONTINUE
     443 191  CONTINUE
     444C
     445      ENDIF
     446C
     447 1    CONTINUE
    452448C
    453449C ----------- AA Test en fin de ADVX ------ Controle des S*

  • LMDZ6/trunk/libf/dyn3d_common/advxp.F

    r5077 r5084  
    126126c test
    127127c  -------------------------------------
    128         DO j =1,jjp1
     128        DO 300 j =1,jjp1
    129129         NUM(j) =1
    130       END DO
     130 300  CONTINUE
    131131c       DO l=1,llm
    132132c      NUM(2,l)=6
    … …  
    150150C  ugri est en kg/s
    151151
    152        DO l = 1,llm
    153        DO j = 1,jjp1
    154        DO i = 1,iip1
     152       DO 500 l = 1,llm
     153       DO 500 j = 1,jjp1
     154       DO 500 i = 1,iip1
    155155       ugri (i,j,llm+1-l) =pbaru (i,j,l)
    156       END DO
    157       END DO
    158       END DO
     156 500   CONTINUE
    159157
    160158C  ---------------------------------------------------------
    … …  
    163161C  boucle principale sur les niveaux et les latitudes
    164162C     
    165       DO L=1,NIV
    166       DO K=lati,latf
     163      DO 1 L=1,NIV
     164      DO 1 K=lati,latf
    167165
    168166C
    … …  
    171169C  program assumes periodic boundaries in X
    172170C
    173       DO I=2,LON
     171      DO 10 I=2,LON
    174172         SMNEW(I)=SM(I,K,L)+(UGRI(I-1,K,L)-UGRI(I,K,L))*DTX
    175       END DO
     173 10   CONTINUE
    176174      SMNEW(1)=SM(1,K,L)+(UGRI(LON,K,L)-UGRI(1,K,L))*DTX
    177175C
    … …  
    181179      LONK=LON/NUMK
    182180C
    183       IF(NUMK>1) THEN
    184 C
    185       DO I=1,LON
     181      IF(NUMK.GT.1) THEN
     182C
     183      DO 111 I=1,LON
    186184         TM(I)=0.
    187       END DO
    188       DO JV=1,NTRA
    189       DO I=1,LON
     185 111  CONTINUE
     186      DO 112 JV=1,NTRA
     187      DO 1120 I=1,LON
    190188         T0 (I,JV)=0.
    191189         TX (I,JV)=0.
    … …  
    198196         TYZ(I,JV)=0.
    199197         TZZ(I,JV)=0.
    200       END DO
    201       END DO
    202 C
    203       DO I2=1,NUMK
    204 C
    205          DO I=1,LONK
     198 1120 CONTINUE
     199 112  CONTINUE
     200C
     201      DO 11 I2=1,NUMK
     202C
     203         DO 113 I=1,LONK
    206204            I3=(I-1)*NUMK+I2
    207205            TM(I)=TM(I)+SM(I3,K,L)
    … …  
    212210            ALF2(I)=ALF1(I)-ALF(I)
    213211            ALF3(I)=ALF(I)*ALF1(I)
    214       END DO
    215 C
    216          DO JV=1,NTRA
    217          DO I=1,LONK
     212 113     CONTINUE
     213C
     214         DO 114 JV=1,NTRA
     215         DO 1140 I=1,LONK
    218216            I3=(I-1)*NUMK+I2
    219217            TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*S0(I3,K,L,JV)
    … …  
    231229            TYZ(I,JV)=TYZ(I,JV)+SYZ(I3,K,L,JV)
    232230            TZZ(I,JV)=TZZ(I,JV)+SZZ(I3,K,L,JV)
    233       END DO
    234       END DO
    235 C
    236       END DO
     231 1140    CONTINUE
     232 114     CONTINUE
     233C
     234 11   CONTINUE
    237235C
    238236      ELSE
    239237C
    240       DO I=1,LON
     238      DO 115 I=1,LON
    241239         TM(I)=SM(I,K,L)
    242       END DO
    243       DO JV=1,NTRA
    244       DO I=1,LON
     240 115  CONTINUE
     241      DO 116 JV=1,NTRA
     242      DO 1160 I=1,LON
    245243         T0 (I,JV)=S0 (I,K,L,JV)
    246244         TX (I,JV)=SSX (I,K,L,JV)
    … …  
    253251         TYZ(I,JV)=SYZ(I,K,L,JV)
    254252         TZZ(I,JV)=SZZ(I,K,L,JV)
    255       END DO
    256       END DO
     253 1160 CONTINUE
     254 116  CONTINUE
    257255C
    258256      ENDIF
    259257C
    260       DO I=1,LONK
     258      DO 117 I=1,LONK
    261259         UEXT(I)=UGRI(I*NUMK,K,L)
    262       END DO
     260 117  CONTINUE
    263261C
    264262C  place limits on appropriate moments before transport
    … …  
    267265      IF(.NOT.LIMIT) GO TO 13
    268266C
    269       DO JV=1,NTRA
    270       DO I=1,LONK
    271         IF(T0(I,JV)>0.) THEN
     267      DO 12 JV=1,NTRA
     268      DO 120 I=1,LONK
     269        IF(T0(I,JV).GT.0.) THEN
    272270          SLPMAX=T0(I,JV)
    273271          S1MAX=1.5*SLPMAX
    … …  
    285283          TXZ(I,JV)=0.
    286284        ENDIF
    287       END DO
    288       END DO
     285 120  CONTINUE
     286 12   CONTINUE
    289287C
    290288 13   CONTINUE
    … …  
    296294C  flux from IP to I if U(I).lt.0
    297295C
    298       DO I=1,LONK-1
    299          IF(UEXT(I)<0.) THEN
     296      DO 140 I=1,LONK-1
     297         IF(UEXT(I).LT.0.) THEN
    300298           FM(I)=-UEXT(I)*DTX
    301299           ALF(I)=FM(I)/TM(I+1)
    302300           TM(I+1)=TM(I+1)-FM(I)
    303301         ENDIF
    304       END DO
     302 140  CONTINUE
    305303C
    306304      I=LONK
    307       IF(UEXT(I)<0.) THEN
     305      IF(UEXT(I).LT.0.) THEN
    308306        FM(I)=-UEXT(I)*DTX
    309307        ALF(I)=FM(I)/TM(1)
    … …  
    313311C  flux from I to IP if U(I).gt.0
    314312C
    315       DO I=1,LONK
    316          IF(UEXT(I)>=0.) THEN
     313      DO 141 I=1,LONK
     314         IF(UEXT(I).GE.0.) THEN
    317315           FM(I)=UEXT(I)*DTX
    318316           ALF(I)=FM(I)/TM(I)
    319317           TM(I)=TM(I)-FM(I)
    320318         ENDIF
    321       END DO
    322 C
    323       DO I=1,LONK
     319 141  CONTINUE
     320C
     321      DO 142 I=1,LONK
    324322         ALFQ(I)=ALF(I)*ALF(I)
    325323         ALF1(I)=1.-ALF(I)
    … …  
    328326         ALF3(I)=ALF(I)*ALFQ(I)
    329327         ALF4(I)=ALF1(I)*ALF1Q(I)
    330       END DO
    331 C
    332       DO JV=1,NTRA
    333       DO I=1,LONK-1
    334 C
    335          IF(UEXT(I)<0.) THEN
     328 142  CONTINUE
     329C
     330      DO 150 JV=1,NTRA
     331      DO 1500 I=1,LONK-1
     332C
     333         IF(UEXT(I).LT.0.) THEN
    336334C
    337335           F0 (I,JV)=ALF (I)* ( T0(I+1,JV)-ALF1(I)*
    … …  
    360358         ENDIF
    361359C
    362       END DO
    363       END DO
     360 1500 CONTINUE
     361 150  CONTINUE
    364362C
    365363      I=LONK
    366       IF(UEXT(I)<0.) THEN
    367 C
    368         DO JV=1,NTRA
     364      IF(UEXT(I).LT.0.) THEN
     365C
     366        DO 151 JV=1,NTRA
    369367C
    370368           F0 (I,JV)=ALF (I)* ( T0(1,JV)-ALF1(I)*
    … …  
    391389           TXZ(1,JV)=ALF1Q(I)*TXZ(1,JV)
    392390C
    393       END DO
     391 151    CONTINUE
    394392C
    395393      ENDIF
    396394C
    397       DO JV=1,NTRA
    398       DO I=1,LONK
    399 C
    400          IF(UEXT(I)>=0.) THEN
     395      DO 152 JV=1,NTRA
     396      DO 1520 I=1,LONK
     397C
     398         IF(UEXT(I).GE.0.) THEN
    401399C
    402400           F0 (I,JV)=ALF (I)* ( T0(I,JV)+ALF1(I)*
    … …  
    425423         ENDIF
    426424C
    427       END DO
    428       END DO
     425 1520 CONTINUE
     426 152  CONTINUE
    429427C
    430428C  puts the temporary moments Fi into appropriate neighboring boxes
    431429C
    432       DO I=1,LONK
    433          IF(UEXT(I)<0.) THEN
     430      DO 160 I=1,LONK
     431         IF(UEXT(I).LT.0.) THEN
    434432           TM(I)=TM(I)+FM(I)
    435433           ALF(I)=FM(I)/TM(I)
    436434         ENDIF
    437       END DO
    438 C
    439       DO I=1,LONK-1
    440          IF(UEXT(I)>=0.) THEN
     435 160  CONTINUE
     436C
     437      DO 161 I=1,LONK-1
     438         IF(UEXT(I).GE.0.) THEN
    441439           TM(I+1)=TM(I+1)+FM(I)
    442440           ALF(I)=FM(I)/TM(I+1)
    443441         ENDIF
    444       END DO
     442 161  CONTINUE
    445443C
    446444      I=LONK
    447       IF(UEXT(I)>=0.) THEN
     445      IF(UEXT(I).GE.0.) THEN
    448446        TM(1)=TM(1)+FM(I)
    449447        ALF(I)=FM(I)/TM(1)
    450448      ENDIF
    451449C
    452       DO I=1,LONK
     450      DO 162 I=1,LONK
    453451         ALF1(I)=1.-ALF(I)
    454452         ALFQ(I)=ALF(I)*ALF(I)
    … …  
    456454         ALF2(I)=ALF1(I)-ALF(I)
    457455         ALF3(I)=ALF(I)*ALF1(I)
    458       END DO
    459 C
    460       DO JV=1,NTRA
    461       DO I=1,LONK
    462 C
    463          IF(UEXT(I)<0.) THEN
     456 162  CONTINUE
     457C
     458      DO 170 JV=1,NTRA
     459      DO 1700 I=1,LONK
     460C
     461         IF(UEXT(I).LT.0.) THEN
    464462C
    465463           TEMPTM=-ALF(I)*T0(I,JV)+ALF1(I)*F0(I,JV)
    … …  
    480478         ENDIF
    481479C
    482       END DO
    483       END DO
    484 C
    485       DO JV=1,NTRA
    486       DO I=1,LONK-1
    487 C
    488          IF(UEXT(I)>=0.) THEN
     480 1700 CONTINUE
     481 170  CONTINUE
     482C
     483      DO 171 JV=1,NTRA
     484      DO 1710 I=1,LONK-1
     485C
     486         IF(UEXT(I).GE.0.) THEN
    489487C
    490488           TEMPTM=ALF(I)*T0(I+1,JV)-ALF1(I)*F0(I,JV)
    … …  
    505503         ENDIF
    506504C
    507       END DO
    508       END DO
     505 1710 CONTINUE
     506 171  CONTINUE
    509507C
    510508      I=LONK
    511       IF(UEXT(I)>=0.) THEN
    512         DO JV=1,NTRA
     509      IF(UEXT(I).GE.0.) THEN
     510        DO 172 JV=1,NTRA
    513511           TEMPTM=ALF(I)*T0(1,JV)-ALF1(I)*F0(I,JV)
    514512           T0 (1,JV)=T0(1,JV)+F0(I,JV)
    … …  
    525523           TYZ(1,JV)=TYZ(1,JV)+FYZ(I,JV)
    526524           TZZ(1,JV)=TZZ(1,JV)+FZZ(I,JV)
    527       END DO
     525 172    CONTINUE
    528526      ENDIF
    529527C
    530528C  retour aux mailles d'origine (passage des Tij aux Sij)
    531529C
    532       IF(NUMK>1) THEN
    533 C
    534       DO I2=1,NUMK
    535 C
    536          DO I=1,LONK
     530      IF(NUMK.GT.1) THEN
     531C
     532      DO 18 I2=1,NUMK
     533C
     534         DO 180 I=1,LONK
    537535C
    538536            I3=I2+(I-1)*NUMK
    … …  
    548546            ALF4(I)=ALF1(I)*ALF1Q(I)
    549547C
    550       END DO
    551 C
    552          DO JV=1,NTRA
    553          DO I=1,LONK
     548 180     CONTINUE
     549C
     550         DO 181 JV=1,NTRA
     551         DO 181 I=1,LONK
    554552C
    555553            I3=I2+(I-1)*NUMK
    … …  
    579577            TXZ(I,JV)=ALF1Q(I)*TXZ(I,JV)
    580578C
    581       END DO
    582       END DO
    583 C
    584       END DO
     579 181     CONTINUE
     580C
     581 18   CONTINUE
    585582C
    586583      ELSE
    587584C
    588       DO I=1,LON
     585      DO 190 I=1,LON
    589586         SM(I,K,L)=TM(I)
    590       END DO
    591       DO JV=1,NTRA
    592       DO I=1,LON
     587 190  CONTINUE
     588      DO 191 JV=1,NTRA
     589      DO 1910 I=1,LON
    593590         S0 (I,K,L,JV)=T0 (I,JV)
    594591         SSX (I,K,L,JV)=TX (I,JV)
    … …  
    601598         SYZ(I,K,L,JV)=TYZ(I,JV)
    602599         SZZ(I,K,L,JV)=TZZ(I,JV)
    603       END DO
    604       END DO
     600 1910 CONTINUE
     601 191  CONTINUE
    605602C
    606603      ENDIF
    607604C
    608       END DO
    609       END DO
     605 1    CONTINUE
    610606C
    611607C ----------- AA Test en fin de ADVX ------ Controle des S*

  • LMDZ6/trunk/libf/dyn3d_common/advy.F

    r5079 r5084  
    121121      enddo
    122122
    123       DO L=1,NIV
     123      DO 1 L=1,NIV
    124124C
    125125C  place limits on appropriate moments before transport
    … …  
    128128      IF(.NOT.LIMIT) GO TO 11
    129129C
    130       DO JV=1,NTRA
    131       DO K=1,LAT
    132       DO I=1,LON
     130      DO 10 JV=1,NTRA
     131      DO 10 K=1,LAT
     132      DO 100 I=1,LON
    133133         sy(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
    134134     +                           ABS(sy(I,K,L,JV))),sy(I,K,L,JV))
    135       END DO
    136       END DO
    137       END DO
     135 100  CONTINUE
     136 10   CONTINUE
    138137C
    139138 11   CONTINUE
    … …  
    142141C
    143142      SM0=0.
    144       DO JV=1,NTRA
     143      DO 20 JV=1,NTRA
    145144         S00(JV)=0.
    146       END DO
    147 C
    148       DO I=1,LON
    149 C
    150          IF(VGRI(I,0,L)<=0.) THEN
     145 20   CONTINUE
     146C
     147      DO 21 I=1,LON
     148C
     149         IF(VGRI(I,0,L).LE.0.) THEN
    151150           FM(I,0)=-VGRI(I,0,L)*DTY
    152151           ALF(I,0)=FM(I,0)/SM(I,1,L)
    … …  
    159158         ALF1Q(I,0)=ALF1(I,0)*ALF1(I,0)
    160159C
    161       END DO
    162 C
    163       DO JV=1,NTRA
    164       DO I=1,LON
    165 C
    166          IF(VGRI(I,0,L)<=0.) THEN
     160 21   CONTINUE
     161C
     162      DO 22 JV=1,NTRA
     163      DO 220 I=1,LON
     164C
     165         IF(VGRI(I,0,L).LE.0.) THEN
    167166C
    168167           F0(I,0,JV)=ALF(I,0)*
    … …  
    177176         ENDIF
    178177C
    179       END DO
    180       END DO
    181 C
    182       DO I=1,LON
    183          IF(VGRI(I,0,L)>0.) THEN
     178 220  CONTINUE
     179 22   CONTINUE
     180C
     181      DO 23 I=1,LON
     182         IF(VGRI(I,0,L).GT.0.) THEN
    184183           FM(I,0)=VGRI(I,0,L)*DTY
    185184           ALF(I,0)=FM(I,0)/SM0
    186185         ENDIF
    187       END DO
    188 C
    189       DO JV=1,NTRA
    190       DO I=1,LON
    191          IF(VGRI(I,0,L)>0.) THEN
     186 23   CONTINUE
     187C
     188      DO 24 JV=1,NTRA
     189      DO 240 I=1,LON
     190         IF(VGRI(I,0,L).GT.0.) THEN
    192191           F0(I,0,JV)=ALF(I,0)*S00(JV)
    193192         ENDIF
    194       END DO
    195       END DO
     193 240  CONTINUE
     194 24   CONTINUE
    196195C
    197196C  puts the temporary moments Fi into appropriate neighboring boxes
    198197C
    199       DO I=1,LON
    200 C
    201          IF(VGRI(I,0,L)>0.) THEN
     198      DO 25 I=1,LON
     199C
     200         IF(VGRI(I,0,L).GT.0.) THEN
    202201           SM(I,1,L)=SM(I,1,L)+FM(I,0)
    203202           ALF(I,0)=FM(I,0)/SM(I,1,L)
    … …  
    206205         ALF1(I,0)=1.-ALF(I,0)
    207206C
    208       END DO
    209 C
    210       DO JV=1,NTRA
    211       DO I=1,LON
    212 C
    213          IF(VGRI(I,0,L)>0.) THEN
     207 25   CONTINUE
     208C
     209      DO 26 JV=1,NTRA
     210      DO 260 I=1,LON
     211C
     212         IF(VGRI(I,0,L).GT.0.) THEN
    214213C
    215214         TEMPTM=ALF(I,0)*S0(I,1,L,JV)-ALF1(I,0)*F0(I,0,JV)
    … …  
    219218         ENDIF
    220219C
    221       END DO
    222       END DO
     220 260  CONTINUE
     221 26   CONTINUE
    223222C
    224223C  calculate flux and moments between adjacent boxes
    … …  
    228227C  flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
    229228C
    230       DO K=1,LAT-1
     229      DO 30 K=1,LAT-1
    231230      KP=K+1
    232       DO I=1,LON
    233 C
    234          IF(VGRI(I,K,L)<0.) THEN
     231      DO 300 I=1,LON
     232C
     233         IF(VGRI(I,K,L).LT.0.) THEN
    235234           FM(I,K)=-VGRI(I,K,L)*DTY
    236235           ALF(I,K)=FM(I,K)/SM(I,KP,L)
    … …  
    246245         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
    247246C
    248       END DO
    249       END DO
    250 C
    251       DO JV=1,NTRA
    252       DO K=1,LAT-1
     247 300  CONTINUE
     248 30   CONTINUE
     249C
     250      DO 31 JV=1,NTRA
     251      DO 31 K=1,LAT-1
    253252      KP=K+1
    254       DO I=1,LON
    255 C
    256          IF(VGRI(I,K,L)<0.) THEN
     253      DO 310 I=1,LON
     254C
     255         IF(VGRI(I,K,L).LT.0.) THEN
    257256C
    258257           F0(I,K,JV)=ALF (I,K)*
    … …  
    282281         ENDIF
    283282C
    284       END DO
    285       END DO
    286       END DO
     283 310  CONTINUE
     284 31   CONTINUE
    287285C
    288286C  puts the temporary moments Fi into appropriate neighboring boxes
    289287C
    290       DO K=1,LAT-1
     288      DO 32 K=1,LAT-1
    291289      KP=K+1
    292       DO I=1,LON
    293 C
    294          IF(VGRI(I,K,L)<0.) THEN
     290      DO 320 I=1,LON
     291C
     292         IF(VGRI(I,K,L).LT.0.) THEN
    295293           SM(I,K,L)=SM(I,K,L)+FM(I,K)
    296294           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    302300         ALF1(I,K)=1.-ALF(I,K)
    303301C
    304       END DO
    305       END DO
    306 C
    307       DO JV=1,NTRA
    308       DO K=1,LAT-1
     302 320  CONTINUE
     303 32   CONTINUE
     304C
     305      DO 33 JV=1,NTRA
     306      DO 33 K=1,LAT-1
    309307      KP=K+1
    310       DO I=1,LON
    311 C
    312          IF(VGRI(I,K,L)<0.) THEN
     308      DO 330 I=1,LON
     309C
     310         IF(VGRI(I,K,L).LT.0.) THEN
    313311C
    314312         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
    … …  
    330328         ENDIF
    331329C
    332       END DO
    333       END DO
    334       END DO
     330 330  CONTINUE
     331 33   CONTINUE
    335332C
    336333C  traitement special pour le pole Sud (idem pole Nord)
    … …  
    339336C
    340337      SM0=0.
    341       DO JV=1,NTRA
     338      DO 40 JV=1,NTRA
    342339         S00(JV)=0.
    343       END DO
    344 C
    345       DO I=1,LON
    346 C
    347          IF(VGRI(I,K,L)>=0.) THEN
     340 40   CONTINUE
     341C
     342      DO 41 I=1,LON
     343C
     344         IF(VGRI(I,K,L).GE.0.) THEN
    348345           FM(I,K)=VGRI(I,K,L)*DTY
    349346           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    356353         ALF1Q(I,K)=ALF1(I,K)*ALF1(I,K)
    357354C
    358       END DO
    359 C
    360       DO JV=1,NTRA
    361       DO I=1,LON
    362 C
    363          IF(VGRI(I,K,L)>=0.) THEN
     355 41   CONTINUE
     356C
     357      DO 42 JV=1,NTRA
     358      DO 420 I=1,LON
     359C
     360         IF(VGRI(I,K,L).GE.0.) THEN
    364361           F0 (I,K,JV)=ALF(I,K)*
    365362     +                ( S0(I,K,L,JV)+ALF1(I,K)*sy(I,K,L,JV) )
    … …  
    372369         ENDIF
    373370C
    374       END DO
    375       END DO
    376 C
    377       DO I=1,LON
    378          IF(VGRI(I,K,L)<0.) THEN
     371 420  CONTINUE
     372 42   CONTINUE
     373C
     374      DO 43 I=1,LON
     375         IF(VGRI(I,K,L).LT.0.) THEN
    379376           FM(I,K)=-VGRI(I,K,L)*DTY
    380377           ALF(I,K)=FM(I,K)/SM0
    381378         ENDIF
    382       END DO
    383 C
    384       DO JV=1,NTRA
    385       DO I=1,LON
    386          IF(VGRI(I,K,L)<0.) THEN
     379 43   CONTINUE
     380C
     381      DO 44 JV=1,NTRA
     382      DO 440 I=1,LON
     383         IF(VGRI(I,K,L).LT.0.) THEN
    387384           F0(I,K,JV)=ALF(I,K)*S00(JV)
    388385         ENDIF
    389       END DO
    390       END DO
     386 440  CONTINUE
     387 44   CONTINUE
    391388C
    392389C  puts the temporary moments Fi into appropriate neighboring boxes
    393390C
    394       DO I=1,LON
    395 C
    396          IF(VGRI(I,K,L)<0.) THEN
     391      DO 45 I=1,LON
     392C
     393         IF(VGRI(I,K,L).LT.0.) THEN
    397394           SM(I,K,L)=SM(I,K,L)+FM(I,K)
    398395           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    401398         ALF1(I,K)=1.-ALF(I,K)
    402399C
    403       END DO
    404 C
    405       DO JV=1,NTRA
    406       DO I=1,LON
    407 C
    408          IF(VGRI(I,K,L)<0.) THEN
     400 45   CONTINUE
     401C
     402      DO 46 JV=1,NTRA
     403      DO 460 I=1,LON
     404C
     405         IF(VGRI(I,K,L).LT.0.) THEN
    409406C
    410407         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
    … …  
    414411         ENDIF
    415412C
    416       END DO
    417       END DO
    418 C
    419       END DO
     413 460  CONTINUE
     414 46   CONTINUE
     415C
     416 1    CONTINUE
    420417C
    421418      RETURN

  • LMDZ6/trunk/libf/dyn3d_common/advyp.F

    r5079 r5084  
    153153C-AA 20/10/94  le signe -1 est necessaire car indexation opposee
    154154
    155       DO l = 1,llm
    156          DO j = 1,jjm
    157             DO i = 1,iip1
     155      DO 500 l = 1,llm
     156         DO 500 j = 1,jjm
     157            DO 500 i = 1,iip1 
    158158            vgri (i,j,llm+1-l)=-1.*pbarv (i,j,l)
    159       END DO
    160       END DO
    161       END DO
     159  500 CONTINUE
    162160
    163161CAA Initialisation de flux fictifs aux bords sup. des boites pol.
    … …  
    173171C  boucle sur les niveaux
    174172C
    175       DO L=1,NIV
     173      DO 1 L=1,NIV
    176174C
    177175C  place limits on appropriate moments before transport
    … …  
    180178      IF(.NOT.LIMIT) GO TO 11
    181179C
    182       DO JV=1,NTRA
    183       DO K=1,LAT
    184       DO I=1,LON
    185          IF(S0(I,K,L,JV)>0.) THEN
     180      DO 10 JV=1,NTRA
     181      DO 10 K=1,LAT
     182      DO 100 I=1,LON
     183         IF(S0(I,K,L,JV).GT.0.) THEN
    186184           SLPMAX=AMAX1(S0(I,K,L,JV),0.)
    187185           S1MAX=1.5*SLPMAX
    … …  
    199197           SYZ(I,K,L,JV)=0.
    200198         ENDIF
    201       END DO
    202       END DO
    203       END DO
     199 100  CONTINUE
     200 10   CONTINUE
    204201C
    205202 11   CONTINUE
    … …  
    208205C
    209206      SM0=0.
    210       DO JV=1,NTRA
     207      DO 20 JV=1,NTRA
    211208         S00(JV)=0.
    212       END DO
    213 C
    214       DO I=1,LON
    215 C
    216          IF(VGRI(I,0,L)<=0.) THEN
     209 20   CONTINUE
     210C
     211      DO 21 I=1,LON
     212C
     213         IF(VGRI(I,0,L).LE.0.) THEN
    217214           FM(I,0)=-VGRI(I,0,L)*DTY
    218215           ALF(I,0)=FM(I,0)/SM(I,1,L)
    … …  
    228225         ALF4(I,0)=ALF1(I,0)*ALF1Q(I,0)
    229226C
    230       END DO
     227 21   CONTINUE
    231228c     print*,'ADVYP 21'
    232229C
    233       DO JV=1,NTRA
    234       DO I=1,LON
    235 C
    236          IF(VGRI(I,0,L)<=0.) THEN
     230      DO 22 JV=1,NTRA
     231      DO 220 I=1,LON
     232C
     233         IF(VGRI(I,0,L).LE.0.) THEN
    237234C
    238235           F0(I,0,JV)=ALF(I,0)* ( S0(I,1,L,JV)-ALF1(I,0)*
    … …  
    256253         ENDIF
    257254C
    258       END DO
    259       END DO
    260 C
    261       DO I=1,LON
    262          IF(VGRI(I,0,L)>0.) THEN
     255 220  CONTINUE
     256 22   CONTINUE
     257C
     258      DO 23 I=1,LON
     259         IF(VGRI(I,0,L).GT.0.) THEN
    263260           FM(I,0)=VGRI(I,0,L)*DTY
    264261           ALF(I,0)=FM(I,0)/SM0
    265262         ENDIF
    266       END DO
    267 C
    268       DO JV=1,NTRA
    269       DO I=1,LON
    270          IF(VGRI(I,0,L)>0.) THEN
     263 23   CONTINUE
     264C
     265      DO 24 JV=1,NTRA
     266      DO 240 I=1,LON
     267         IF(VGRI(I,0,L).GT.0.) THEN
    271268           F0(I,0,JV)=ALF(I,0)*S00(JV)
    272269         ENDIF
    273       END DO
    274       END DO
     270 240  CONTINUE
     271 24   CONTINUE
    275272C
    276273C  puts the temporary moments Fi into appropriate neighboring boxes
    277274C
    278275c     print*,'av ADVYP 25'
    279       DO I=1,LON
    280 C
    281          IF(VGRI(I,0,L)>0.) THEN
     276      DO 25 I=1,LON
     277C
     278         IF(VGRI(I,0,L).GT.0.) THEN
    282279           SM(I,1,L)=SM(I,1,L)+FM(I,0)
    283280           ALF(I,0)=FM(I,0)/SM(I,1,L)
    … …  
    290287         ALF3(I,0)=ALF1(I,0)*ALF(I,0)
    291288C
    292       END DO
     289 25   CONTINUE
    293290c     print*,'av ADVYP 25'
    294291C
    295       DO JV=1,NTRA
    296       DO I=1,LON
    297 C
    298          IF(VGRI(I,0,L)>0.) THEN
     292      DO 26 JV=1,NTRA
     293      DO 260 I=1,LON
     294C
     295         IF(VGRI(I,0,L).GT.0.) THEN
    299296C
    300297         TEMPTM=ALF(I,0)*S0(I,1,L,JV)-ALF1(I,0)*F0(I,0,JV)
    … …  
    308305         ENDIF
    309306C
    310       END DO
    311       END DO
     307 260  CONTINUE
     308 26   CONTINUE
    312309C
    313310C  calculate flux and moments between adjacent boxes
    … …  
    318315C
    319316c     print*,'av ADVYP 30'
    320       DO K=1,LAT-1
     317      DO 30 K=1,LAT-1
    321318      KP=K+1
    322       DO I=1,LON
    323 C
    324          IF(VGRI(I,K,L)<0.) THEN
     319      DO 300 I=1,LON
     320C
     321         IF(VGRI(I,K,L).LT.0.) THEN
    325322           FM(I,K)=-VGRI(I,K,L)*DTY
    326323           ALF(I,K)=FM(I,K)/SM(I,KP,L)
    … …  
    339336         ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
    340337C
    341       END DO
    342       END DO
     338 300  CONTINUE
     339 30   CONTINUE
    343340c     print*,'ap ADVYP 30'
    344341C
    345       DO JV=1,NTRA
    346       DO K=1,LAT-1
     342      DO 31 JV=1,NTRA
     343      DO 31 K=1,LAT-1
    347344      KP=K+1
    348       DO I=1,LON
    349 C
    350          IF(VGRI(I,K,L)<0.) THEN
     345      DO 310 I=1,LON
     346C
     347         IF(VGRI(I,K,L).LT.0.) THEN
    351348C
    352349           F0 (I,K,JV)=ALF (I,K)* ( S0(I,KP,L,JV)-ALF1(I,K)*
    … …  
    406403         ENDIF
    407404C
    408       END DO
    409       END DO
    410       END DO
     405 310  CONTINUE
     406 31   CONTINUE
    411407c     print*,'ap ADVYP 31'
    412408C
    413409C  puts the temporary moments Fi into appropriate neighboring boxes
    414410C
    415       DO K=1,LAT-1
     411      DO 32 K=1,LAT-1
    416412      KP=K+1
    417       DO I=1,LON
    418 C
    419          IF(VGRI(I,K,L)<0.) THEN
     413      DO 320 I=1,LON
     414C
     415         IF(VGRI(I,K,L).LT.0.) THEN
    420416           SM(I,K,L)=SM(I,K,L)+FM(I,K)
    421417           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    431427         ALF3(I,K)=ALF1(I,K)*ALF(I,K)
    432428C
    433       END DO
    434       END DO
     429 320  CONTINUE
     430 32   CONTINUE
    435431c     print*,'ap ADVYP 32'
    436432C
    437       DO JV=1,NTRA
    438       DO K=1,LAT-1
     433      DO 33 JV=1,NTRA
     434      DO 33 K=1,LAT-1
    439435      KP=K+1
    440       DO I=1,LON
    441 C
    442          IF(VGRI(I,K,L)<0.) THEN
     436      DO 330 I=1,LON
     437C
     438         IF(VGRI(I,K,L).LT.0.) THEN
    443439C
    444440         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
    … …  
    478474         ENDIF
    479475C
    480       END DO
    481       END DO
    482       END DO
     476 330  CONTINUE
     477 33   CONTINUE
    483478c     print*,'ap ADVYP 33'
    484479C
    … …  
    488483C
    489484      SM0=0.
    490       DO JV=1,NTRA
     485      DO 40 JV=1,NTRA
    491486         S00(JV)=0.
    492       END DO
    493 C
    494       DO I=1,LON
    495 C
    496          IF(VGRI(I,K,L)>=0.) THEN
     487 40   CONTINUE
     488C
     489      DO 41 I=1,LON
     490C
     491         IF(VGRI(I,K,L).GE.0.) THEN
    497492           FM(I,K)=VGRI(I,K,L)*DTY
    498493           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    508503         ALF4(I,K)=ALF1(I,K)*ALF1Q(I,K)
    509504C
    510       END DO
     505 41   CONTINUE
    511506c     print*,'ap ADVYP 41'
    512507C
    513       DO JV=1,NTRA
    514       DO I=1,LON
    515 C
    516          IF(VGRI(I,K,L)>=0.) THEN
     508      DO 42 JV=1,NTRA
     509      DO 420 I=1,LON
     510C
     511         IF(VGRI(I,K,L).GE.0.) THEN
    517512           F0 (I,K,JV)=ALF(I,K)* ( S0(I,K,L,JV)+ALF1(I,K)*
    518513     +             ( SY(I,K,L,JV)+ALF2(I,K)*SYY(I,K,L,JV) ) )
    … …  
    532527         ENDIF
    533528C
    534       END DO
    535       END DO
     529 420  CONTINUE
     530 42   CONTINUE
    536531c     print*,'ap ADVYP 42'
    537532C
    538       DO I=1,LON
    539          IF(VGRI(I,K,L)<0.) THEN
     533      DO 43 I=1,LON
     534         IF(VGRI(I,K,L).LT.0.) THEN
    540535           FM(I,K)=-VGRI(I,K,L)*DTY
    541536           ALF(I,K)=FM(I,K)/SM0
    542537         ENDIF
    543       END DO
     538 43   CONTINUE
    544539c     print*,'ap ADVYP 43'
    545540C
    546       DO JV=1,NTRA
    547       DO I=1,LON
    548          IF(VGRI(I,K,L)<0.) THEN
     541      DO 44 JV=1,NTRA
     542      DO 440 I=1,LON
     543         IF(VGRI(I,K,L).LT.0.) THEN
    549544           F0(I,K,JV)=ALF(I,K)*S00(JV)
    550545         ENDIF
    551       END DO
    552       END DO
     546 440  CONTINUE
     547 44   CONTINUE
    553548C
    554549C  puts the temporary moments Fi into appropriate neighboring boxes
    555550C
    556       DO I=1,LON
    557 C
    558          IF(VGRI(I,K,L)<0.) THEN
     551      DO 45 I=1,LON
     552C
     553         IF(VGRI(I,K,L).LT.0.) THEN
    559554           SM(I,K,L)=SM(I,K,L)+FM(I,K)
    560555           ALF(I,K)=FM(I,K)/SM(I,K,L)
    … …  
    567562         ALF3(I,K)=ALF1(I,K)*ALF(I,K)
    568563C
    569       END DO
     564 45   CONTINUE
    570565c     print*,'ap ADVYP 45'
    571566C
    572       DO JV=1,NTRA
    573       DO I=1,LON
    574 C
    575          IF(VGRI(I,K,L)<0.) THEN
     567      DO 46 JV=1,NTRA
     568      DO 460 I=1,LON
     569C
     570         IF(VGRI(I,K,L).LT.0.) THEN
    576571C
    577572         TEMPTM=-ALF(I,K)*S0(I,K,L,JV)+ALF1(I,K)*F0(I,K,JV)
    … …  
    585580         ENDIF
    586581C
    587       END DO
    588       END DO
     582 460  CONTINUE
     583 46   CONTINUE
    589584c     print*,'ap ADVYP 46'
    590585C
    591       END DO
     586 1    CONTINUE
    592587
    593588c--------------------------------------------------

  • LMDZ6/trunk/libf/dyn3d_common/advz.F

    r5079 r5084  
    117117C  Conversion du flux de masse en kg.s-1
    118118
    119       DO l = 1,llm
    120          DO j = 1,jjp1
    121             DO i = 1,iip1 
     119      DO 500 l = 1,llm
     120         DO 500 j = 1,jjp1
     121            DO 500 i = 1,iip1 
    122122c            wgri (i,j,llm+1-l) =  w (i,j,l) / g
    123123               wgri (i,j,llm+1-l) =  w (i,j,l)
    … …  
    125125c             wgri (i,j,l) = 0.1               !    w (i,j,l)
    126126c             wgri (i,j,llm) = 0.              ! a detruire ult.
    127       END DO
    128       END DO
    129       END DO
     127  500 CONTINUE
    130128         DO  j = 1,jjp1
    131129            DO i = 1,iip1 
    … …  
    139137C  boucle sur les latitudes
    140138C
    141       DO K=1,LAT
     139      DO 1 K=1,LAT
    142140C
    143141C  place limits on appropriate moments before transport
    … …  
    146144      IF(.NOT.LIMIT) GO TO 101
    147145C
    148       DO JV=1,NTRA
    149       DO L=1,NIV
    150          DO I=1,LON
     146      DO 10 JV=1,NTRA
     147      DO 10 L=1,NIV
     148         DO 100 I=1,LON
    151149            sz(I,K,L,JV)=SIGN(AMIN1(AMAX1(S0(I,K,L,JV),0.),
    152150     +                              ABS(sz(I,K,L,JV))),sz(I,K,L,JV))
    153       END DO
    154       END DO
    155       END DO
     151 100     CONTINUE
     152 10   CONTINUE
    156153C
    157154 101  CONTINUE
    … …  
    165162C  2- reajusts moments remaining in the box
    166163C
    167       DO L=1,NIV-1
     164      DO 11 L=1,NIV-1
    168165      LP=L+1
    169166C
    170       DO I=1,LON
    171 C
    172          IF(WGRI(I,K,L)<0.) THEN
     167      DO 110 I=1,LON
     168C
     169         IF(WGRI(I,K,L).LT.0.) THEN
    173170           FM(I,L)=-WGRI(I,K,L)*DTZ
    174171           ALF(I)=FM(I,L)/SM(I,K,LP)
    … …  
    184181         ALF1Q(I)=ALF1(I)*ALF1(I)
    185182C
    186       END DO
    187 C
    188       DO JV=1,NTRA
    189       DO I=1,LON
    190 C
    191          IF(WGRI(I,K,L)<0.) THEN
     183 110  CONTINUE
     184C
     185      DO 111 JV=1,NTRA
     186      DO 1110 I=1,LON
     187C
     188         IF(WGRI(I,K,L).LT.0.) THEN
    192189C
    193190           F0(I,L,JV)=ALF (I)*( S0(I,K,LP,JV)-ALF1(I)*sz(I,K,LP,JV) )
    … …  
    215212         ENDIF
    216213C
    217       END DO
    218       END DO
    219 C
    220       END DO
     214 1110 CONTINUE
     215 111  CONTINUE
     216C
     217 11   CONTINUE
    221218C
    222219C  puts the temporary moments Fi into appropriate neighboring boxes
    223220C
    224       DO L=1,NIV-1
     221      DO 12 L=1,NIV-1
    225222      LP=L+1
    226223C
    227       DO I=1,LON
    228 C
    229          IF(WGRI(I,K,L)<0.) THEN
     224      DO 120 I=1,LON
     225C
     226         IF(WGRI(I,K,L).LT.0.) THEN
    230227           SM(I,K,L)=SM(I,K,L)+FM(I,L)
    231228           ALF(I)=FM(I,L)/SM(I,K,L)
    … …  
    239236         ALF1Q(I)=ALF1(I)*ALF1(I)
    240237C
    241       END DO
    242 C
    243       DO JV=1,NTRA
    244       DO I=1,LON
    245 C
    246          IF(WGRI(I,K,L)<0.) THEN
     238 120  CONTINUE
     239C
     240      DO 121 JV=1,NTRA
     241      DO 1210 I=1,LON
     242C
     243         IF(WGRI(I,K,L).LT.0.) THEN
    247244C
    248245           TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
    … …  
    263260         ENDIF
    264261C
    265       END DO
    266       END DO
    267 C
    268       END DO
     262 1210 CONTINUE
     263 121  CONTINUE
     264C
     265 12   CONTINUE
    269266C
    270267C  fin de la boucle principale sur les latitudes
    271268C
    272       END DO
     269 1    CONTINUE
    273270C
    274271C-------------------------------------------------------------

  • LMDZ6/trunk/libf/dyn3d_common/advzp.F

    r5079 r5084  
    135135C  Conversion des flux de masses en kg
    136136
    137       DO l = 1,llm
    138          DO j = 1,jjp1
    139             DO i = 1,iip1 
     137      DO 500 l = 1,llm
     138         DO 500 j = 1,jjp1
     139            DO 500 i = 1,iip1 
    140140            wgri (i,j,llm+1-l) = w (i,j,l) 
    141       END DO
    142       END DO
    143       END DO
     141  500 CONTINUE
    144142      do j=1,jjp1
    145143         do i=1,iip1
    … …  
    156154C  boucle sur les latitudes
    157155C
    158       DO K=1,LAT
     156      DO 1 K=1,LAT
    159157C
    160158C  place limits on appropriate moments before transport
    … …  
    163161      IF(.NOT.LIMIT) GO TO 101
    164162C
    165       DO JV=1,NTRA
    166       DO L=1,NIV
    167          DO I=1,LON
    168             IF(S0(I,K,L,JV)>0.) THEN
     163      DO 10 JV=1,NTRA
     164      DO 10 L=1,NIV
     165         DO 100 I=1,LON
     166            IF(S0(I,K,L,JV).GT.0.) THEN
    169167              SLPMAX=S0(I,K,L,JV)
    170168              S1MAX =1.5*SLPMAX
    … …  
    182180              SYZ(I,K,L,JV)=0.
    183181            ENDIF
    184       END DO
    185       END DO
    186       END DO
     182 100     CONTINUE
     183 10   CONTINUE
    187184C
    188185 101  CONTINUE
    … …  
    196193C  2- reajusts moments remaining in the box
    197194C
    198       DO L=1,NIV-1
     195      DO 11 L=1,NIV-1
    199196      LP=L+1
    200197C
    201       DO I=1,LON
    202 C
    203          IF(WGRI(I,K,L)<0.) THEN
     198      DO 110 I=1,LON
     199C
     200         IF(WGRI(I,K,L).LT.0.) THEN
    204201           FM(I,L)=-WGRI(I,K,L)*DTZ
    205202           ALF(I)=FM(I,L)/SM(I,K,LP)
    … …  
    218215         ALF4 (I)=ALF1(I)*ALF1Q(I)
    219216C
    220       END DO
    221 C
    222       DO JV=1,NTRA
    223       DO I=1,LON
    224 C
    225          IF(WGRI(I,K,L)<0.) THEN
     217 110  CONTINUE
     218C
     219      DO 111 JV=1,NTRA
     220      DO 1110 I=1,LON
     221C
     222         IF(WGRI(I,K,L).LT.0.) THEN
    226223C
    227224           F0 (I,L,JV)=ALF (I)* ( S0(I,K,LP,JV)-ALF1(I)*
    … …  
    276273         ENDIF
    277274C
    278       END DO
    279       END DO
    280 C
    281       END DO
     275 1110 CONTINUE
     276 111  CONTINUE
     277C
     278 11   CONTINUE
    282279C
    283280C  puts the temporary moments Fi into appropriate neighboring boxes
    284281C
    285       DO L=1,NIV-1
     282      DO 12 L=1,NIV-1
    286283      LP=L+1
    287284C
    288       DO I=1,LON
    289 C
    290          IF(WGRI(I,K,L)<0.) THEN
     285      DO 120 I=1,LON
     286C
     287         IF(WGRI(I,K,L).LT.0.) THEN
    291288           SM(I,K,L)=SM(I,K,L)+FM(I,L)
    292289           ALF(I)=FM(I,L)/SM(I,K,L)
    … …  
    302299         ALF3(I)=ALF1(I)-ALF(I)
    303300C
    304       END DO
    305 C
    306       DO JV=1,NTRA
    307       DO I=1,LON
    308 C
    309          IF(WGRI(I,K,L)<0.) THEN
     301 120  CONTINUE
     302C
     303      DO 121 JV=1,NTRA
     304      DO 1210 I=1,LON
     305C
     306         IF(WGRI(I,K,L).LT.0.) THEN
    310307C
    311308           TEMPTM=-ALF(I)*S0(I,K,L,JV)+ALF1(I)*F0(I,L,JV)
    … …  
    345342         ENDIF
    346343C
    347       END DO
    348       END DO
    349 C
    350       END DO
     344 1210 CONTINUE
     345 121  CONTINUE
     346C
     347 12   CONTINUE
    351348C
    352349C  fin de la boucle principale sur les latitudes
    353350C
    354       END DO
     351 1    CONTINUE
    355352C
    356353      DO l = 1,llm

  • LMDZ6/trunk/libf/dyn3d_common/comdissip.h

    r5077 r5084  
    66
    77      COMMON/comdissip/                                                 &
    8      &    coefdis,tetavel,tetatemp,gamdissip,niterdis
     8     &    niterdis,coefdis,tetavel,tetatemp,gamdissip
    99
    1010

  • LMDZ6/trunk/libf/dyn3d_common/extrapol.F

    r5079 r5084  
    5858200   CONTINUE
    5959      incre = incre + 1
    60       DO j = 1, kylat
    61       DO i = 1, kxlon
    62       IF (pfild(i,j)> zwmsk) THEN
     60      DO 99999 j = 1, kylat
     61      DO 99999 i = 1, kxlon
     62      IF (pfild(i,j).GT. zwmsk) THEN
    6363         pwork(i,j) = pfild(i,j)
    6464         inbor = 0
    … …  
    8989C
    9090C* Correct latitude bounds if southernmost or northernmost points
    91          IF (j == 1) ideb = 4
    92          IF (j == kylat) ifin = 6
     91         IF (j .EQ. 1) ideb = 4
     92         IF (j .EQ. kylat) ifin = 6
    9393C
    9494C* Account for periodicity in longitude
    9595C
    9696         IF (ldper) THEN
    97             IF (i == kxlon) THEN
     97            IF (i .EQ. kxlon) THEN
    9898               ix(3) = 1
    9999               ix(6) = 1
    100100               ix(9) = 1
    101             ELSE IF (i == 1) THEN
     101            ELSE IF (i .EQ. 1) THEN
    102102               ix(1) = kxlon
    103103               ix(4) = kxlon
    … …  
    105105            ENDIF
    106106         ELSE
    107             IF (i == 1) THEN
     107            IF (i .EQ. 1) THEN
    108108               ix(1) = i
    109109               ix(2) = i + 1
    … …  
    113113               ix(6) = i + 1
    114114            ENDIF
    115             IF (i == kxlon) THEN
     115            IF (i .EQ. kxlon) THEN
    116116               ix(1) = i -1
    117117               ix(2) = i
    … …  
    122122            ENDIF
    123123C
    124             IF (i == 1 .OR. i == kxlon) THEN
     124            IF (i .EQ. 1 .OR. i .EQ. kxlon) THEN
    125125               jy(1) = MAX (1,j-1)
    126126               jy(2) = MAX (1,j-1)
    … …  
    132132               ideb = 1
    133133               ifin = 6
    134                IF (j == 1) ideb = 3
    135                IF (j == kylat) ifin = 4
     134               IF (j .EQ. 1) ideb = 3
     135               IF (j .EQ. kylat) ifin = 4
    136136            ENDIF
    137137         ENDIF ! end for ldper test
    … …  
    139139C* Find unmasked neighbors
    140140C
    141          DO k = ideb, ifin
     141         DO 230 k = ideb, ifin
    142142            zmask(k) = 0.
    143143            ilon = ix(k)
    144144            jlat = jy(k)
    145             IF (pfild(ilon,jlat) < zwmsk) THEN
     145            IF (pfild(ilon,jlat) .LT. zwmsk) THEN
    146146               zmask(k) = 1.
    147147               inbor = inbor + 1
    148148            ENDIF
    149       END DO
     149 230     CONTINUE
    150150C
    151151C* Not enough points around point P are unmasked; interpolation on P
    152152C  will be done in a future call to extrap.
    153153C
    154          IF (inbor >= knbor) THEN
     154         IF (inbor .GE. knbor) THEN
    155155            pwork(i,j) = 0.
    156156            DO k = ideb, ifin
    … …  
    163163C
    164164      ENDIF
    165       END DO
    166       END DO
     16599999 CONTINUE
    167166C
    168167C*    3. Writing back unmasked field in pfild
    … …  
    177176      DO j = 1, kylat
    178177      DO i = 1, kxlon
    179          IF (pwork(i,j) > zwmsk) idoit = idoit + 1
     178         IF (pwork(i,j) .GT. zwmsk) idoit = idoit + 1
    180179         pfild(i,j) = pwork(i,j)
    181180      ENDDO
    182181      ENDDO
    183182c
    184       IF (idoit /= 0) GOTO 200
     183      IF (idoit .ne. 0) GOTO 200
    185184ccc      PRINT*, "Number of extrapolation steps incre =", incre
    186185c

  • LMDZ6/trunk/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90

    r5075 r5084  
    1414  USE comconst_mod, ONLY: cpp, kappa, g, omeg, daysec, rad, pi
    1515  USE comvert_mod, ONLY: presnivs, preff, pa
    16   USE lmdz_netcdf, ONLY: nf90_def_var, nf90_int, nf90_float, nf90_put_var, nf_enddef, &
    17       nf_put_att_text,nf_def_dim,nf_64bit_offset,nf_clobber,nf_create
     16  use netcdf, only: nf90_def_var, nf90_int, nf90_float, nf90_put_var
    1817 
    1918  IMPLICIT NONE
    … …  
    2221  INCLUDE "paramet.h"
    2322  INCLUDE "comgeom.h"
     23  INCLUDE "netcdf.inc"
    2424
    2525!========================
    … …  
    232232
    233233SUBROUTINE handle_err(status)
    234   USE lmdz_netcdf, ONLY: nf_strerror
     234  INCLUDE "netcdf.inc"
    235235
    236236  INTEGER status
    237   IF (status/=nf_noerr) THEN
     237  IF (status.NE.nf_noerr) THEN
    238238     PRINT *,NF_STRERROR(status)
    239239     CALL abort_gcm('grilles_gcm_netcdf','netcdf error',1)

  • LMDZ6/trunk/libf/dyn3d_common/ppm3d.F

    r5079 r5084  
    6868      implicit none
    6969
    70 c     rajout de d�clarations
     70c     rajout de déclarations
    7171c      integer Jmax,kmax,ndt0,nstep,k,j,i,ic,l,js,jn,imh,iad,jad,krd
    7272c      integer iu,iiu,j2,jmr,js0,jt
    … …  
    315315C
    316316C *********** Initialization **********************
    317       if(NSTEP==1) then
     317      if(NSTEP.eq.1) then
    318318c
    319319      write(6,*) '------------------------------------ '
    … …  
    325325C
    326326C controles sur les parametres
    327       if(NLAY<6) then
     327      if(NLAY.LT.6) then
    328328        write(6,*) 'NLAY must be >= 6'
    329329        stop
    330330      endif
    331       if (JNP<NLAY) then
     331      if (JNP.LT.NLAY) then
    332332         write(6,*) 'JNP must be >= NLAY'
    333333        stop
    334334      endif
    335335      IMRD2=mod(IMR,2)
    336       if (j1==2.and.IMRD2/=0) then
     336      if (j1.eq.2.and.IMRD2.NE.0) then
    337337         write(6,*) 'if j1=2 IMR must be an even integer'
    338338        stop
    … …  
    340340
    341341C
    342       if(Jmax<JNP .or. Kmax<NLAY) then
     342      if(Jmax.lt.JNP .or. Kmax.lt.NLAY) then
    343343        write(6,*) 'Jmax or Kmax is too small'
    344344        stop
    … …  
    354354      DP =    PI / REAL(JMR)
    355355C
    356       if(IGD==0) then
     356      if(IGD.eq.0) then
    357357C Compute analytic cosine at cell edges
    358358            call cosa(cosp,cose,JNP,PI,DP)
    … …  
    362362      endif
    363363C
    364       do J=2,JMR
    365       acosp(j) = 1. / cosp(j)
    366       END DO
     364      do 15 J=2,JMR
     36515    acosp(j) = 1. / cosp(j)
    367366C
    368367C Inverse of the Scaled polar cap area.
    … …  
    373372      endif
    374373C
    375       if(NDT0 /= NDT) then
     374      if(NDT0 .ne. NDT) then
    376375      DT   = NDT
    377376      NDT0 = NDT
    378377
    379         if(Umax < 180.) then
     378        if(Umax .lt. 180.) then
    380379         write(6,*) 'Umax may be too small!'
    381380        endif
    … …  
    383382      MaxDT = DP*AE / abs(Umax) + 0.5
    384383      write(6,*)'Largest time step for max(V)=',Umax,' is ',MaxDT
    385       if(MaxDT < abs(NDT)) then
     384      if(MaxDT .lt. abs(NDT)) then
    386385            write(6,*) 'Warning!!! NDT maybe too large!'
    387386      endif
    388387C
    389       if(CR1>=0.95) then
     388      if(CR1.ge.0.95) then
    390389      JS0 = 0
    391390      JN0 = 0
    … …  
    430429         
    431430C
    432       if(j1/=2) then
    433       DO IC=1,NC
    434       DO L=1,NLAY
    435       DO I=1,IMR
     431      if(j1.ne.2) then
     432      DO 40 IC=1,NC
     433      DO 40 L=1,NLAY
     434      DO 40 I=1,IMR
    436435      Q(I,  2,L,IC) = Q(I,  1,L,IC)
    437       Q(I,JMR,L,IC) = Q(I,JNP,L,IC)
    438       END DO
    439       END DO
    440       END DO
     43640    Q(I,JMR,L,IC) = Q(I,JNP,L,IC)
    441437      endif
    442438C
    443439C Compute "tracer density"
    444       DO IC=1,NC
    445       DO k=1,NLAY
    446       DO j=1,JNP
    447       DO i=1,IMR
    448       DQ(i,j,k,IC) = Q(i,j,k,IC)*delp1(i,j,k)
    449       END DO
    450       END DO
    451       END DO
    452       END DO
    453 C
    454       do k=1,NLAY
    455 C
    456       if(IGD==0) then
     440      DO 550 IC=1,NC
     441      DO 44 k=1,NLAY
     442      DO 44 j=1,JNP
     443      DO 44 i=1,IMR
     44444    DQ(i,j,k,IC) = Q(i,j,k,IC)*delp1(i,j,k)
     445550     continue
     446C
     447      do 1500 k=1,NLAY
     448C
     449      if(IGD.eq.0) then
    457450C Convert winds on A-Grid to Courant # on C-Grid.
    458451      call A2C(U(1,1,k),V(1,1,k),IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
    459452      else
    460453C Convert winds on C-grid to Courant #
    461       do j=j1,j2
    462       do i=2,IMR
    463       CRX(i,J) = dtdx(j)*U(i-1,j,k)
    464       END DO
    465       END DO
     454      do 45 j=j1,j2
     455      do 45 i=2,IMR
     45645    CRX(i,J) = dtdx(j)*U(i-1,j,k)
    466457   
    467458C
    468       do j=j1,j2
    469       CRX(1,J) = dtdx(j)*U(IMR,j,k)
    470       END DO
    471 C
    472       do i=1,IMR*JMR
    473       CRY(i,2) = DTDY*V(i,1,k)
    474       END DO
     459      do 50 j=j1,j2
     46050    CRX(1,J) = dtdx(j)*U(IMR,j,k)
     461C
     462      do 55 i=1,IMR*JMR
     46355    CRY(i,2) = DTDY*V(i,1,k)
    475464      endif
    476465C     
    … …  
    481470      do j=JS0,j1+1,-1
    482471      do i=1,IMR
    483       if(abs(CRX(i,j))>1.) then
     472      if(abs(CRX(i,j)).GT.1.) then
    484473            JS = j
    485474            go to 2222
    … …  
    491480      do j=JN0,j2-1
    492481      do i=1,IMR
    493       if(abs(CRX(i,j))>1.) then
     482      if(abs(CRX(i,j)).GT.1.) then
    494483            JN = j
    495484            go to 2233
    … …  
    4994882233  continue
    500489C
    501       if(j1/=2) then           ! Enlarged polar cap.
     490      if(j1.ne.2) then           ! Enlarged polar cap.
    502491      do i=1,IMR
    503492      DPI(i,  2,k) = 0.
    … …  
    516505      enddo
    517506C
    518       do j=j1,j2
    519       DO i=1,IMR
    520       DPI(i,j,k) = (ymass(i,j) - ymass(i,j+1)) * acosp(j)
    521       END DO
    522       END DO
     507      do 95 j=j1,j2
     508      DO 95 i=1,IMR
     50995    DPI(i,j,k) = (ymass(i,j) - ymass(i,j+1)) * acosp(j)
    523510C
    524511C Poles
    … …  
    549536      enddo
    550537C
    551       do j=j1,j2
    552       DO i=1,IMR
    553       xmass(i,j) = PU(i,j)*CRX(i,j)
    554       END DO
    555       END DO
    556 C
    557       DO j=j1,j2
    558       DO i=1,IMR-1
    559       DPI(i,j,k) = DPI(i,j,k) + xmass(i,j) - xmass(i+1,j)
    560       END DO
    561       END DO
    562 C
    563       DO j=j1,j2
    564       DPI(IMR,j,k) = DPI(IMR,j,k) + xmass(IMR,j) - xmass(1,j)
    565       END DO
     538      do 110 j=j1,j2
     539      DO 110 i=1,IMR
     540110   xmass(i,j) = PU(i,j)*CRX(i,j)
     541C
     542      DO 120 j=j1,j2
     543      DO 120 i=1,IMR-1
     544120   DPI(i,j,k) = DPI(i,j,k) + xmass(i,j) - xmass(i+1,j)
     545C
     546      DO 130 j=j1,j2
     547130   DPI(IMR,j,k) = DPI(IMR,j,k) + xmass(IMR,j) - xmass(1,j)
    566548C
    567549      DO j=j1,j2
    … …  
    587569      enddo
    588570C
    589       if(j1==2) then
     571      if(j1.eq.2) then
    590572        IMH = IMR/2
    591573      do i=1,IMH
    … …  
    600582C
    601583C ****6***0*********0*********0*********0*********0*********0**********72
    602       do IC=1,NC
     584      do 1000 IC=1,NC
    603585C
    604586      do i=1,IMJM
    … …  
    608590C
    609591C E-W advective cross term
    610       do j=J1,J2
    611       if(J>JS  .and. J<JN) GO TO 250
     592      do 250 j=J1,J2
     593      if(J.GT.JS  .and. J.LT.JN) GO TO 250
    612594C
    613595      do i=1,IMR
    … …  
    620602      enddo
    621603C
    622       DO i=1,IMR
     604      DO 230 i=1,IMR
    623605      iu = UA(i,j)
    624606      ru = UA(i,j) - iu
    625607      iiu = i-iu
    626       if(UA(i,j)>=0.) then
     608      if(UA(i,j).GE.0.) then
    627609      wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
    628610      else
    … …  
    630612      endif
    631613      wk1(i,j,1) = wk1(i,j,1) - qtmp(i)
    632       END DO
     614230   continue
    633615250   continue
    634       END DO
    635 C
    636       if(JN/=0) then
     616C
     617      if(JN.ne.0) then
    637618      do j=JS+1,JN-1
    638619C
    … …  
    664645        if(cross) then
    665646C Add cross terms in the vertical direction.
    666         if(IORD >= 2) then
     647        if(IORD .GE. 2) then
    667648                iad = 2
    668649        else
    … …  
    670651        endif
    671652C
    672         if(JORD >= 2) then
     653        if(JORD .GE. 2) then
    673654                jad = 2
    674655        else
    … …  
    690671     &  DC2,ymass,WK1(1,1,3),wk1(1,1,4),WK1(1,1,5),WK1(1,1,6),JORD)
    691672C
    692       END DO
    693       END DO
     6731000  continue
     6741500  continue
    694675C
    695676C ******* Compute vertical mass flux (same unit as PS) ***********
    … …  
    697678C 1st step: compute total column mass CONVERGENCE.
    698679C
    699       do j=1,JNP
    700       do i=1,IMR
    701       CRY(i,j) = DPI(i,j,1)
    702       END DO
    703       END DO
    704 C
    705       do k=2,NLAY
    706       do j=1,JNP
    707       do i=1,IMR
     680      do 320 j=1,JNP
     681      do 320 i=1,IMR
     682320   CRY(i,j) = DPI(i,j,1)
     683C
     684      do 330 k=2,NLAY
     685      do 330 j=1,JNP
     686      do 330 i=1,IMR
    708687      CRY(i,j)  = CRY(i,j) + DPI(i,j,k)
    709       END DO
    710       END DO
    711       END DO
    712 C
    713       do j=1,JNP
    714       do i=1,IMR
     688330   continue
     689C
     690      do 360 j=1,JNP
     691      do 360 i=1,IMR
    715692C
    716693C 2nd step: compute PS2 (PS at n+1) using the hydrostatic assumption.
    … …  
    723700      W(i,j,1) = DPI(i,j,1) - DBK(1)*CRY(i,j)
    724701      W(i,j,NLAY) = 0.
    725       END DO
    726       END DO
    727 C
    728       do k=2,NLAY-1
    729       do j=1,JNP
    730       do i=1,IMR
     702360   continue
     703C
     704      do 370 k=2,NLAY-1
     705      do 370 j=1,JNP
     706      do 370 i=1,IMR
    731707      W(i,j,k) = W(i,j,k-1) + DPI(i,j,k) - DBK(k)*CRY(i,j)
    732       END DO
    733       END DO
    734       END DO
    735 C
    736       DO k=1,NLAY
    737       DO j=1,JNP
    738       DO i=1,IMR
     708370   continue
     709C
     710      DO 380 k=1,NLAY
     711      DO 380 j=1,JNP
     712      DO 380 i=1,IMR
    739713      delp2(i,j,k) = DAP(k) + DBK(k)*PS2(i,j)
    740       END DO
    741       END DO
    742       END DO
     714380   continue
    743715C
    744716        KRD = max(3, KORD)
    745       do IC=1,NC
     717      do 4000 IC=1,NC
    746718C
    747719C****6***0*********0*********0*********0*********0*********0**********72
    … …  
    766738      enddo
    767739C     
    768       if(j1/=2) then
    769       DO k=1,NLAY
    770       DO I=1,IMR
    771 c     j=1 c'est le p�le Sud, j=JNP c'est le p�le Nord
     740      if(j1.ne.2) then
     741      DO 400 k=1,NLAY
     742      DO 400 I=1,IMR
     743c     j=1 c'est le pôle Sud, j=JNP c'est le pôle Nord
    772744      Q(I,  2,k,IC) = Q(I,  1,k,IC)
    773745      Q(I,JMR,k,IC) = Q(I,JNP,k,IC)
    774       END DO
    775       END DO
    776       endif
    777       END DO
    778 C
    779       if(j1/=2) then
    780       DO k=1,NLAY
    781       DO i=1,IMR
     746400   CONTINUE
     747      endif
     7484000  continue
     749C
     750      if(j1.ne.2) then
     751      DO 5000 k=1,NLAY
     752      DO 5000 i=1,IMR
    782753      W(i,  2,k) = W(i,  1,k)
    783754      W(i,JMR,k) = W(i,JNP,k)
    784       END DO
    785       END DO
     7555000  continue
    786756      endif
    787757C
    … …  
    815785C ****6***0*********0*********0*********0*********0*********0**********72
    816786C
    817       do k=1,NLAYM1
    818       do i=1,IMJM
     787      do 1000 k=1,NLAYM1
     788      do 1000 i=1,IMJM
    819789      DQDT(i,1,k) = P(i,1,k+1) - P(i,1,k)
    820       END DO
    821       END DO
    822 C
    823       DO k=2,NLAYM1
    824       DO I=1,IMJM
     7901000  continue
     791C
     792      DO 1220 k=2,NLAYM1
     793      DO 1220 I=1,IMJM   
    825794       c0 =  delp(i,1,k) / (delp(i,1,k-1)+delp(i,1,k)+delp(i,1,k+1))
    826795       c1 = (delp(i,1,k-1)+0.5*delp(i,1,k))/(delp(i,1,k+1)+delp(i,1,k))   
    … …  
    830799      Qmin = P(i,1,k) - min(P(i,1,k-1),P(i,1,k),P(i,1,k+1))
    831800      DC(i,1,k) = sign(min(abs(tmp),Qmax,Qmin), tmp)   
    832       END DO
    833       END DO
     8011220  CONTINUE
    834802     
    835803C     
    … …  
    838806C ****6***0*********0*********0*********0*********0*********0**********72
    839807C
    840       DO j=1,JNP
    841       if((j==2 .or. j==JMR) .and. j1/=2) goto 2000
     808      DO 2000 j=1,JNP
     809      if((j.eq.2 .or. j.eq.JMR) .and. j1.ne.2) goto 2000
    842810C
    843811      DO k=1,NLAY
    … …  
    860828C
    861829C First guess top edge value
    862       DO i=1,IMR
     830      DO 10 i=1,IMR
    863831C three-cell PPM
    864832C Compute a,b, and c of q = aP**2 + bP + c using cell averages and delp
    … …  
    872840C
    873841C Check if change sign
    874       if(wk1(i,1)*AL(i,1)<=0.) then
     842      if(wk1(i,1)*AL(i,1).le.0.) then
    875843                 AL(i,1) = 0.
    876844             flux(i,1) = 0.
    … …  
    878846             flux(i,1) =  wk1(i,1) - AL(i,1)
    879847        endif
    880       END DO
     84810    continue
    881849C
    882850C Bottom
    883       DO i=1,IMR
     851      DO 15 i=1,IMR
    884852C 2-cell PPM with zero gradient right at the surface
    885853C
    … …  
    888856      AR(i,NLAY) = wk1(i,NLAY) + fct
    889857      AL(i,NLAY) = wk1(i,NLAY) - (fct+fct)
    890       if(wk1(i,NLAY)*AR(i,NLAY)<=0.) AR(i,NLAY) = 0.
     858      if(wk1(i,NLAY)*AR(i,NLAY).le.0.) AR(i,NLAY) = 0.
    891859      flux(i,NLAY) = AR(i,NLAY) -  wk1(i,NLAY)
    892       END DO
     86015    continue
    893861     
    894862C
    … …  
    897865C****6***0*********0*********0*********0*********0*********0**********72
    898866C
    899       DO k=3,NLAYM1
    900       DO i=1,IMR
     867      DO 14 k=3,NLAYM1
     868      DO 12 i=1,IMR
    901869      c1 =  DQDT(i,j,k-1)*wk2(i,k-1) / (wk2(i,k-1)+wk2(i,k))
    902870      c2 =  2. / (wk2(i,k-2)+wk2(i,k-1)+wk2(i,k)+wk2(i,k+1))
    … …  
    907875     &          wk2(i,k-1)*A1*flux(i,k)  )
    908876C      print *,'AL1',i,k, AL(i,k)
    909       END DO
    910       END DO
    911 C
    912       do i=1,IMR*NLAYM1
     87712    CONTINUE
     87814    continue
     879C
     880      do 20 i=1,IMR*NLAYM1
    913881      AR(i,1) = AL(i,2)
    914882C      print *,'AR1',i,AR(i,1)
    915       END DO
    916 C
    917       do i=1,IMR*NLAY
     88320    continue
     884C
     885      do 30 i=1,IMR*NLAY
    918886      A6(i,1) = 3.*(wk1(i,1)+wk1(i,1) - (AL(i,1)+AR(i,1)))
    919887C      print *,'A61',i,A6(i,1)
    920       END DO
     88830    continue
    921889C
    922890C****6***0*********0*********0*********0*********0*********0**********72
    … …  
    927895C
    928896C Interior depending on KORD
    929       if(LMT<=2)
     897      if(LMT.LE.2)
    930898     &  call lmtppm(flux(1,2),A6(1,2),AR(1,2),AL(1,2),wk1(1,2),
    931899     &              IMR*(NLAY-2),LMT)
    … …  
    933901C****6***0*********0*********0*********0*********0*********0**********72
    934902C
    935       DO i=1,IMR*NLAYM1
    936       IF(wz2(i,1)>0.) then
     903      DO 140 i=1,IMR*NLAYM1
     904      IF(wz2(i,1).GT.0.) then
    937905        CM = wz2(i,1) / wk2(i,1)
    938906        flux(i,2) = AR(i,1)+0.5*CM*(AL(i,1)-AR(i,1)+A6(i,1)*(1.-R23*CM))
    … …  
    944912C        print *,'test2',i, AL(i,2),AR(i,2),A6(i,2),R23
    945913      endif
    946       END DO
    947 C
    948       DO i=1,IMR*NLAYM1
     914140   continue
     915C
     916      DO 250 i=1,IMR*NLAYM1
    949917      flux(i,2) = wz2(i,1) * flux(i,2)
    950       END DO
    951 C
    952       do i=1,IMR
     918250   continue
     919C
     920      do 350 i=1,IMR
    953921      DQ(i,j,   1) = DQ(i,j,   1) - flux(i,   2)
    954922      DQ(i,j,NLAY) = DQ(i,j,NLAY) + flux(i,NLAY)
    955       END DO
    956 C
    957       do k=2,NLAYM1
    958       do i=1,IMR
    959       DQ(i,j,k) = DQ(i,j,k) + flux(i,k) - flux(i,k+1)
    960       END DO
    961       END DO
     923350   continue
     924C
     925      do 360 k=2,NLAYM1
     926      do 360 i=1,IMR
     927360   DQ(i,j,k) = DQ(i,j,k) + flux(i,k) - flux(i,k+1)
    9629282000  continue
    963       END DO
    964929      return
    965930      end
    … …  
    985950      j2vl = j2-jvan
    986951C
    987       do j=j1,j2
     952      do 1310 j=j1,j2
    988953C
    989954      do i=1,IMR
    … …  
    991956      enddo
    992957C
    993       if(j>=JN .or. j<=JS) goto 2222
     958      if(j.ge.JN .or. j.le.JS) goto 2222
    994959C ************* Eulerian **********
    995960C
    … …  
    999964      qtmp(IMP+1) = q(2,J)
    1000965C
    1001       IF(IORD==1 .or. j==j1 .or. j==j2) THEN
    1002       DO i=1,IMR
     966      IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
     967      DO 1406 i=1,IMR
    1003968      iu = REAL(i) - uc(i,j)
    1004       fx1(i) = qtmp(iu)
    1005       END DO
     9691406  fx1(i) = qtmp(iu)
    1006970      ELSE
    1007971      call xmist(IMR,IML,Qtmp,DC)
    1008972      DC(0) = DC(IMR)
    1009973C
    1010       if(IORD==2 .or. j<=j1vl .or. j>=j2vl) then
    1011       DO i=1,IMR
     974      if(IORD.eq.2 .or. j.le.j1vl .or. j.ge.j2vl) then
     975      DO 1408 i=1,IMR
    1012976      iu = REAL(i) - uc(i,j)
    1013       fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j))
    1014       END DO
     9771408  fx1(i) = qtmp(iu) + DC(iu)*(sign(1.,uc(i,j))-uc(i,j))
    1015978      else
    1016979      call fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
    … …  
    1019982      ENDIF
    1020983C
    1021       DO i=1,IMR
    1022       fx1(i) = fx1(i)*xmass(i,j)
    1023       END DO
     984      DO 1506 i=1,IMR
     9851506  fx1(i) = fx1(i)*xmass(i,j)
    1024986C
    1025987      goto 1309
    … …  
    1034996      enddo
    1035997C
    1036       IF(IORD==1 .or. j==j1 .or. j==j2) THEN
    1037       DO i=1,IMR
     998      IF(IORD.eq.1 .or. j.eq.j1. or. j.eq.j2) THEN
     999      DO 1306 i=1,IMR
    10381000      itmp = INT(uc(i,j))
    10391001      ISAVE(i) = i - itmp
    10401002      iu = i - uc(i,j)
    1041       fx1(i) = (uc(i,j) - itmp)*qtmp(iu)
    1042       END DO
     10031306  fx1(i) = (uc(i,j) - itmp)*qtmp(iu)
    10431004      ELSE
    10441005      call xmist(IMR,IML,Qtmp,DC)
    … …  
    10491010      enddo
    10501011C
    1051       DO i=1,IMR
     1012      DO 1307 i=1,IMR
    10521013      itmp = INT(uc(i,j))
    10531014      rut  = uc(i,j) - itmp
    10541015      ISAVE(i) = i - itmp
    10551016      iu = i - uc(i,j)
    1056       fx1(i) = rut*(qtmp(iu) + DC(iu)*(sign(1.,rut) - rut))
    1057       END DO
     10171307  fx1(i) = rut*(qtmp(iu) + DC(iu)*(sign(1.,rut) - rut))
    10581018      ENDIF
    10591019C
    1060       do i=1,IMR
    1061       IF(uc(i,j)>1.) then
     1020      do 1308 i=1,IMR
     1021      IF(uc(i,j).GT.1.) then
    10621022CDIR$ NOVECTOR
    10631023        do ist = ISAVE(i),i-1
    10641024        fx1(i) = fx1(i) + qtmp(ist)
    10651025        enddo
    1066       elseIF(uc(i,j)<-1.) then
     1026      elseIF(uc(i,j).LT.-1.) then
    10671027        do ist = i,ISAVE(i)-1
    10681028        fx1(i) = fx1(i) - qtmp(ist)
    … …  
    10701030CDIR$ VECTOR
    10711031      endif
    1072       END DO
     10321308  continue
    10731033      do i=1,IMR
    10741034      fx1(i) = PU(i,j)*fx1(i)
    … …  
    10781038C
    107910391309  fx1(IMP) = fx1(1)
    1080       DO i=1,IMR
    1081       DQ(i,j) =  DQ(i,j) + fx1(i)-fx1(i+1)
    1082       END DO
     1040      DO 1215 i=1,IMR
     10411215  DQ(i,j) =  DQ(i,j) + fx1(i)-fx1(i+1)
    10831042C
    10841043C ***************************************
    10851044C
    1086       END DO
     10451310  continue
    10871046      return
    10881047      end
    … …  
    11201079C      endif
    11211080C
    1122       DO i=1,IMR
    1123       AL(i) = 0.5*(p(i-1)+p(i)) + (DC(i-1) - DC(i))*R3
    1124       END DO
    1125 C
    1126       do i=1,IMR-1
    1127       AR(i) = AL(i+1)
    1128       END DO
     1081      DO 10 i=1,IMR
     108210    AL(i) = 0.5*(p(i-1)+p(i)) + (DC(i-1) - DC(i))*R3
     1083C
     1084      do 20 i=1,IMR-1
     108520    AR(i) = AL(i+1)
    11291086      AR(IMR) = AL(1)
    11301087C
    1131       do i=1,IMR
    1132       A6(i) = 3.*(p(i)+p(i)  - (AL(i)+AR(i)))
    1133       END DO
    1134 C
    1135       if(LMT<=2) call lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
     1088      do 30 i=1,IMR
     108930    A6(i) = 3.*(p(i)+p(i)  - (AL(i)+AR(i)))
     1090C
     1091      if(LMT.LE.2) call lmtppm(DC(1),A6(1),AR(1),AL(1),P(1),IMR,LMT)
    11361092C
    11371093      AL(0) = AL(IMR)
    … …  
    11401096C
    11411097      DO i=1,IMR
    1142       IF(UT(i)>0.) then
     1098      IF(UT(i).GT.0.) then
    11431099      flux(i) = AR(i-1) + 0.5*UT(i)*(AL(i-1) - AR(i-1) +
    11441100     &                 A6(i-1)*(1.-R23*UT(i)) )
    … …  
    11591115      real :: tmp,pmax,pmin
    11601116C
    1161       do i=1,IMR
     1117      do 10  i=1,IMR
    11621118      tmp = R24*(8.*(p(i+1) - p(i-1)) + p(i-2) - p(i+2))
    11631119      Pmax = max(P(i-1), p(i), p(i+1)) - p(i)
    11641120      Pmin = p(i) - min(P(i-1), p(i), p(i+1))
    1165       DC(i) = sign(min(abs(tmp),Pmax,Pmin), tmp)
    1166       END DO
     112110    DC(i) = sign(min(abs(tmp),Pmax,Pmin), tmp)
    11671122      return
    11681123      end
    … …  
    11831138      len = IMR*(J2-J1+2)
    11841139C
    1185       if(JORD==1) then
    1186       DO i=1,len
     1140      if(JORD.eq.1) then
     1141      DO 1000 i=1,len
    11871142      JT = REAL(J1) - VC(i,J1)
    1188       fx(i,j1) = p(i,JT)
    1189       END DO
     11431000  fx(i,j1) = p(i,JT)
    11901144      else
    11911145   
    11921146      call ymist(IMR,JNP,j1,P,DC2,4)
    11931147C
    1194       if(JORD<=0 .or. JORD>=3) then
     1148      if(JORD.LE.0 .or. JORD.GE.3) then
    11951149   
    11961150      call fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
    11971151   
    11981152      else
    1199       DO i=1,len
     1153      DO 1200 i=1,len
    12001154      JT = REAL(J1) - VC(i,J1)
    1201       fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
    1202       END DO
    1203       endif
    1204       endif
    1205 C
    1206       DO i=1,len
    1207       fx(i,j1) = fx(i,j1)*ymass(i,j1)
    1208       END DO
    1209 C
    1210       DO j=j1,j2
    1211       DO i=1,IMR
    1212       DQ(i,j) = DQ(i,j) + (fx(i,j) - fx(i,j+1)) * acosp(j)
    1213       END DO
    1214       END DO
     11551200  fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
     1156      endif
     1157      endif
     1158C
     1159      DO 1300 i=1,len
     11601300  fx(i,j1) = fx(i,j1)*ymass(i,j1)
     1161C
     1162      DO 1400 j=j1,j2
     1163      DO 1400 i=1,IMR
     11641400  DQ(i,j) = DQ(i,j) + (fx(i,j) - fx(i,j+1)) * acosp(j)
    12151165C
    12161166C Poles
    … …  
    12291179      enddo
    12301180C
    1231       if(j1/=2) then
     1181      if(j1.ne.2) then
    12321182      do i=1,IMR
    12331183      DQ(i,  2) = sum1
    … …  
    12511201      IJM3 = IMR*(JMR-3)
    12521202C
    1253       IF(ID==2) THEN
    1254       do i=1,IMR*(JMR-1)
     1203      IF(ID.EQ.2) THEN
     1204      do 10 i=1,IMR*(JMR-1)
    12551205      tmp = 0.25*(p(i,3) - p(i,1))
    12561206      Pmax = max(p(i,1),p(i,2),p(i,3)) - p(i,2)
    12571207      Pmin = p(i,2) - min(p(i,1),p(i,2),p(i,3))
    12581208      DC(i,2) = sign(min(abs(tmp),Pmin,Pmax),tmp)
    1259       END DO
     120910    CONTINUE
    12601210      ELSE
    1261       do i=1,IMH
     1211      do 12 i=1,IMH
    12621212C J=2
    12631213      tmp = (8.*(p(i,3) - p(i,1)) + p(i+IMH,2) - p(i,4))*R24
    … …  
    12701220      Pmin = p(i,JMR) - min(p(i,JMR-1),p(i,JMR),p(i,JNP))
    12711221      DC(i,JMR) = sign(min(abs(tmp),Pmin,Pmax),tmp)
    1272       END DO
    1273       do i=IMH+1,IMR
     122212    CONTINUE
     1223      do 14 i=IMH+1,IMR
    12741224C J=2
    12751225      tmp = (8.*(p(i,3) - p(i,1)) + p(i-IMH,2) - p(i,4))*R24
    … …  
    12821232      Pmin = p(i,JMR) - min(p(i,JMR-1),p(i,JMR),p(i,JNP))
    12831233      DC(i,JMR) = sign(min(abs(tmp),Pmin,Pmax),tmp)
    1284       END DO
    1285 C
    1286       do i=1,IJM3
     123414    CONTINUE
     1235C
     1236      do 15 i=1,IJM3
    12871237      tmp = (8.*(p(i,4) - p(i,2)) + p(i,1) - p(i,5))*R24
    12881238      Pmax = max(p(i,2),p(i,3),p(i,4)) - p(i,3)
    12891239      Pmin = p(i,3) - min(p(i,2),p(i,3),p(i,4))
    12901240      DC(i,3) = sign(min(abs(tmp),Pmin,Pmax),tmp)
    1291       END DO
     124115    CONTINUE
    12921242      ENDIF
    12931243C
    1294       if(j1/=2) then
     1244      if(j1.ne.2) then
    12951245      do i=1,IMR
    12961246      DC(i,1) = 0.
    … …  
    13001250C Determine slopes in polar caps for scalars!
    13011251C
    1302       do i=1,IMH
     1252      do 13 i=1,IMH
    13031253C South
    13041254      tmp = 0.25*(p(i,2) - p(i+imh,2))
    … …  
    13111261      Pmin = p(i,JNP) - min(p(i+imh,JMR),p(i,jnp), p(i,JMR))
    13121262      DC(i,JNP) = sign(min(abs(tmp),Pmax,pmin),tmp)
    1313       END DO
    1314 C
    1315       do i=imh+1,IMR
     126313    continue
     1264C
     1265      do 25 i=imh+1,IMR
    13161266      DC(i,  1) =  - DC(i-imh,  1)
    13171267      DC(i,JNP) =  - DC(i-imh,JNP)
    1318       END DO
     126825    continue
    13191269      endif
    13201270      return
    … …  
    13581308      LMT = JORD - 3     
    13591309C
    1360       DO i=1,IMR*JMR
     1310      DO 10 i=1,IMR*JMR       
    13611311      AL(i,2) = 0.5*(p(i,1)+p(i,2)) + (DC(i,1) - DC(i,2))*R3
    13621312      AR(i,1) = AL(i,2)
    1363       END DO
     131310    CONTINUE
    13641314C
    13651315CPoles:
    … …  
    13811331     
    13821332           
    1383       do i=1,len
    1384       A6(i,j11) = 3.*(p(i,j11)+p(i,j11)  - (AL(i,j11)+AR(i,j11)))
    1385       END DO
    1386 C
    1387       if(LMT<=2) call lmtppm(DC(1,j11),A6(1,j11),AR(1,j11)
     1333      do 30 i=1,len
     133430    A6(i,j11) = 3.*(p(i,j11)+p(i,j11)  - (AL(i,j11)+AR(i,j11)))
     1335C
     1336      if(LMT.le.2) call lmtppm(DC(1,j11),A6(1,j11),AR(1,j11)
    13881337     &                       ,AL(1,j11),P(1,j11),len,LMT)
    13891338C
    13901339     
    1391       DO i=1,IMJM1
    1392       IF(VC(i,j1)>0.) then
     1340      DO 140 i=1,IMJM1
     1341      IF(VC(i,j1).GT.0.) then
    13931342      flux(i,j1) = AR(i,j11) + 0.5*VC(i,j1)*(AL(i,j11) - AR(i,j11) +
    13941343     &                         A6(i,j11)*(1.-R23*VC(i,j1)) )
    … …  
    13971346     &                        A6(i,j1)*(1.+R23*VC(i,j1)))
    13981347      endif
    1399       END DO
     1348140   continue
    14001349      return
    14011350      end
    … …  
    14291378c        write(*,*) 'toto 1'
    14301379C --------------------------------
    1431       IF(IAD==2) then
     1380      IF(IAD.eq.2) then
    14321381      do j=j1-1,j2+1
    14331382      do i=1,IMR
    … …  
    14461395c      write(*,*) 'toto 2'
    14471396C
    1448       ELSEIF(IAD==1) then
     1397      ELSEIF(IAD.eq.1) then
    14491398        do j=j1-1,j2+1
    14501399      do i=1,imr
    … …  
    14551404      ENDIF
    14561405C
    1457         if(j1/=2) then
     1406        if(j1.ne.2) then
    14581407        sum1 = 0.
    14591408        sum2 = 0.
    … …  
    14991448C
    15001449        JMR = JNP-1
    1501       do j=j1,j2
    1502       if(J>JS  .and. J<JN) GO TO 1309
     1450      do 1309 j=j1,j2
     1451      if(J.GT.JS  .and. J.LT.JN) GO TO 1309
    15031452C
    15041453      do i=1,IMR
    … …  
    15111460      enddo
    15121461C
    1513       IF(IAD==2) THEN
     1462      IF(IAD.eq.2) THEN
    15141463      DO i=1,IMR
    15151464      IP = NINT(UA(i,j))
    … …  
    15201469      adx(i,j) = qtmp(ip) + ru*(a1*ru + b1)
    15211470      enddo
    1522       ELSEIF(IAD==1) then
     1471      ELSEIF(IAD.eq.1) then
    15231472      DO i=1,IMR
    15241473      iu = UA(i,j)
    15251474      ru = UA(i,j) - iu
    15261475      iiu = i-iu
    1527       if(UA(i,j)>=0.) then
     1476      if(UA(i,j).GE.0.) then
    15281477      adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu-1)-qtmp(iiu))
    15291478      else
    … …  
    15371486      enddo
    153814871309  continue
    1539       END DO
    15401488C
    15411489C Eulerian upwind
    … …  
    15501498      qtmp(IMR+1) = p(1,J)
    15511499C
    1552       IF(IAD==2) THEN
     1500      IF(IAD.eq.2) THEN
    15531501      qtmp(-1)     = p(IMR-1,J)
    15541502      qtmp(IMR+2) = p(2,J)
    … …  
    15611509      adx(i,j) = qtmp(ip)- p(i,j) + ru*(a1*ru + b1)
    15621510      enddo
    1563       ELSEIF(IAD==1) then
     1511      ELSEIF(IAD.eq.1) then
    15641512C 1st order
    15651513      DO i=1,IMR
    … …  
    15701518      enddo
    15711519C
    1572         if(j1/=2) then
     1520        if(j1.ne.2) then
    15731521      do i=1,IMR
    15741522      adx(i,  2) = 0.
    … …  
    16061554      REAL da1,da2,a6da,fmin
    16071555C
    1608       if(LMT==0) then
     1556      if(LMT.eq.0) then
    16091557C Full constraint
    1610       do i=1,IM
    1611       if(DC(i)==0.) then
     1558      do 100 i=1,IM
     1559      if(DC(i).eq.0.) then
    16121560            AR(i) = p(i)
    16131561            AL(i) = p(i)
    … …  
    16171565      da2  = da1**2
    16181566      A6DA = A6(i)*da1
    1619       if(A6DA < -da2) then
     1567      if(A6DA .lt. -da2) then
    16201568            A6(i) = 3.*(AL(i)-p(i))
    16211569            AR(i) = AL(i) - A6(i)
    1622       elseif(A6DA > da2) then
     1570      elseif(A6DA .gt. da2) then
    16231571            A6(i) = 3.*(AR(i)-p(i))
    16241572            AL(i) = AR(i) - A6(i)
    16251573      endif
    16261574      endif
    1627       END DO
    1628       elseif(LMT==1) then
     1575100   continue
     1576      elseif(LMT.eq.1) then
    16291577C Semi-monotonic constraint
    1630       do i=1,IM
    1631       if(abs(AR(i)-AL(i)) >= -A6(i)) go to 150
    1632       if(p(i)<AR(i) .and. p(i)<AL(i)) then
     1578      do 150 i=1,IM
     1579      if(abs(AR(i)-AL(i)) .GE. -A6(i)) go to 150
     1580      if(p(i).lt.AR(i) .and. p(i).lt.AL(i)) then
    16331581            AR(i) = p(i)
    16341582            AL(i) = p(i)
    16351583            A6(i) = 0.
    1636       elseif(AR(i) > AL(i)) then
     1584      elseif(AR(i) .gt. AL(i)) then
    16371585            A6(i) = 3.*(AL(i)-p(i))
    16381586            AR(i) = AL(i) - A6(i)
    … …  
    16421590      endif
    16431591150   continue
    1644       END DO
    1645       elseif(LMT==2) then
    1646       do i=1,IM
    1647       if(abs(AR(i)-AL(i)) >= -A6(i)) go to 250
     1592      elseif(LMT.eq.2) then
     1593      do 250 i=1,IM
     1594      if(abs(AR(i)-AL(i)) .GE. -A6(i)) go to 250
    16481595      fmin = p(i) + 0.25*(AR(i)-AL(i))**2/A6(i) + A6(i)*R12
    1649       if(fmin>=0.) go to 250
    1650       if(p(i)<AR(i) .and. p(i)<AL(i)) then
     1596      if(fmin.ge.0.) go to 250
     1597      if(p(i).lt.AR(i) .and. p(i).lt.AL(i)) then
    16511598            AR(i) = p(i)
    16521599            AL(i) = p(i)
    16531600            A6(i) = 0.
    1654       elseif(AR(i) > AL(i)) then
     1601      elseif(AR(i) .gt. AL(i)) then
    16551602            A6(i) = 3.*(AL(i)-p(i))
    16561603            AR(i) = AL(i) - A6(i)
    … …  
    16601607      endif
    16611608250   continue
    1662       END DO
    16631609      endif
    16641610      return
    … …  
    16711617      integer i,j
    16721618C
    1673       do j=j1,j2
    1674       do i=2,IMR
    1675       CRX(i,J) = dtdx5(j)*(U(i,j)+U(i-1,j))
    1676       END DO
    1677       END DO
    1678 C
    1679       do j=j1,j2
    1680       CRX(1,J) = dtdx5(j)*(U(1,j)+U(IMR,j))
    1681       END DO
    1682 C
    1683       do i=1,IMR*JMR
    1684       CRY(i,2) = DTDY5*(V(i,2)+V(i,1))
    1685       END DO
     1619      do 35 j=j1,j2
     1620      do 35 i=2,IMR
     162135    CRX(i,J) = dtdx5(j)*(U(i,j)+U(i-1,j))
     1622C
     1623      do 45 j=j1,j2
     162445    CRX(1,J) = dtdx5(j)*(U(1,j)+U(IMR,j))
     1625C
     1626      do 55 i=1,IMR*JMR
     162755    CRY(i,2) = DTDY5*(V(i,2)+V(i,1))
    16861628      return
    16871629      end
    … …  
    16941636      real ph5
    16951637      JMR = JNP-1
    1696       do j=2,JNP
     1638      do 55 j=2,JNP
    16971639        ph5  =  -0.5*PI + (REAL(J-1)-0.5)*DP
    1698         cose(j) = cos(ph5)
    1699       END DO
     164055      cose(j) = cos(ph5)
    17001641C
    17011642      JEQ = (JNP+1) / 2
    1702       if(JMR == 2*(JMR/2) ) then
     1643      if(JMR .eq. 2*(JMR/2) ) then
    17031644      do j=JNP, JEQ+1, -1
    17041645       cose(j) =  cose(JNP+2-j)
    … …  
    17121653      endif
    17131654C
    1714       do j=2,JMR
    1715       cosp(j) = 0.5*(cose(j)+cose(j+1))
    1716       END DO
     1655      do 66 j=2,JMR
     165666    cosp(j) = 0.5*(cose(j)+cose(j+1))
    17171657      cosp(1) = 0.
    17181658      cosp(JNP) = 0.
    … …  
    17281668C
    17291669      phi = -0.5*PI
    1730       do j=2,JNP-1
     1670      do 55 j=2,JNP-1
    17311671      phi  =  phi + DP
    1732       cosp(j) = cos(phi)
    1733       END DO
     167255    cosp(j) = cos(phi)
    17341673        cosp(  1) = 0.
    17351674        cosp(JNP) = 0.
    17361675C
    1737       do j=2,JNP
     1676      do 66 j=2,JNP
    17381677        cose(j) = 0.5*(cosp(j)+cosp(j-1))
    1739       END DO
    1740 C
    1741       do j=2,JNP-1
     167866    CONTINUE
     1679C
     1680      do 77 j=2,JNP-1
    17421681       cosp(j) = 0.5*(cose(j)+cose(j+1))
    1743       END DO
     168277    CONTINUE
    17441683      return
    17451684      end
    … …  
    17631702        icr = 1
    17641703      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    1765       if(ipy==0) goto 50
     1704      if(ipy.eq.0) goto 50
    17661705      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    1767       if(ipx==0) goto 50
     1706      if(ipx.eq.0) goto 50
    17681707C
    17691708      if(cross) then
    17701709      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    17711710      endif
    1772       if(icr==0) goto 50
     1711      if(icr.eq.0) goto 50
    17731712C
    17741713C Vertical filling...
    17751714      do i=1,len
    1776       IF( Q(i,j1,1)<0.) THEN
     1715      IF( Q(i,j1,1).LT.0.) THEN
    17771716      ip = ip + 1
    17781717          Q(i,j1,2) = Q(i,j1,2) + Q(i,j1,1)
    … …  
    17821721C
    1783172250    continue
    1784       DO L = 2,NLAYM1
     1723      DO 225 L = 2,NLAYM1
    17851724      icr = 1
    17861725C
    17871726      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    1788       if(ipy==0) goto 225
     1727      if(ipy.eq.0) goto 225
    17891728      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    1790       if(ipx==0) go to 225
     1729      if(ipx.eq.0) go to 225
    17911730      if(cross) then
    17921731      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    17931732      endif
    1794       if(icr==0) goto 225
     1733      if(icr.eq.0) goto 225
    17951734C
    17961735      do i=1,len
    1797       IF( Q(I,j1,L)<0.) THEN
     1736      IF( Q(I,j1,L).LT.0.) THEN
    17981737C
    17991738      ip = ip + 1
    … …  
    18101749      ENDDO
    18111750225   CONTINUE
    1812       END DO
    18131751C
    18141752C BOTTOM LAYER
    … …  
    18171755C
    18181756      call filns(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    1819       if(ipy==0) goto 911
     1757      if(ipy.eq.0) goto 911
    18201758      call filew(q(1,1,L),qtmp,IMR,JNP,j1,j2,ipx,tiny)
    1821       if(ipx==0) goto 911
     1759      if(ipx.eq.0) goto 911
    18221760C
    18231761      call filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    1824       if(icr==0) goto 911
     1762      if(icr.eq.0) goto 911
    18251763C
    18261764      DO  I=1,len
    1827       IF( Q(I,j1,L)<0.) THEN
     1765      IF( Q(I,j1,L).LT.0.) THEN
    18281766      ip = ip + 1
    18291767c
    … …  
    18421780911   continue
    18431781C
    1844       if(ip>IMR) then
     1782      if(ip.gt.IMR) then
    18451783      write(6,*) 'IC=',IC,' STEP=',NSTEP,
    18461784     &           ' Vertical filling pts=',ip
    18471785      endif
    18481786C
    1849       if(sum>1.e-25) then
     1787      if(sum.gt.1.e-25) then
    18501788      write(6,*) IC,NSTEP,' Mass source from the ground=',sum
    18511789      endif
    … …  
    18601798      real :: dq,dn,d0,d1,ds,d2
    18611799      icr = 0
    1862       do j=j1+1,j2-1
    1863       DO i=1,IMR-1
    1864       IF(q(i,j)<0.) THEN
     1800      do 65 j=j1+1,j2-1
     1801      DO 50 i=1,IMR-1
     1802      IF(q(i,j).LT.0.) THEN
    18651803      icr =  1
    18661804      dq  = - q(i,j)*cosp(j)
    … …  
    18781816      q(i,j) = (d2 - dq)*acosp(j) + tiny
    18791817      endif
    1880       END DO
    1881       if(icr==0 .and. q(IMR,j)>=0.) goto 65
    1882       DO i=2,IMR
    1883       IF(q(i,j)<0.) THEN
     181850    continue
     1819      if(icr.eq.0 .and. q(IMR,j).ge.0.) goto 65
     1820      DO 55 i=2,IMR
     1821      IF(q(i,j).LT.0.) THEN
    18841822      icr =  1
    18851823      dq  = - q(i,j)*cosp(j)
    … …  
    18971835      q(i,j) = (d2 - dq)*acosp(j) + tiny
    18981836      endif
    1899       END DO
     183755    continue
    19001838C *****************************************
    19011839C i=1
    19021840      i=1
    1903       IF(q(i,j)<0.) THEN
     1841      IF(q(i,j).LT.0.) THEN
    19041842      icr =  1
    19051843      dq  = - q(i,j)*cosp(j)
    … …  
    19201858C i=IMR
    19211859      i=IMR
    1922       IF(q(i,j)<0.) THEN
     1860      IF(q(i,j).LT.0.) THEN
    19231861      icr =  1
    19241862      dq  = - q(i,j)*cosp(j)
    … …  
    19381876C *****************************************
    1939187765    continue
    1940       END DO
    19411878C
    19421879      do i=1,IMR
    1943       if(q(i,j1)<0. .or. q(i,j2)<0.) then
     1880      if(q(i,j1).lt.0. .or. q(i,j2).lt.0.) then
    19441881      icr = 1
    19451882      goto 80
    … …  
    1949188680    continue
    19501887C
    1951       if(q(1,1)<0. .or. q(1,jnp)<0.) then
     1888      if(q(1,1).lt.0. .or. q(1,jnp).lt.0.) then
    19521889      icr = 1
    19531890      endif
    … …  
    19731910C
    19741911      ipy = 0
    1975       do j=j1+1,j2-1
    1976       DO i=1,IMR
    1977       IF(q(i,j)<0.) THEN
     1912      do 55 j=j1+1,j2-1
     1913      DO 55 i=1,IMR
     1914      IF(q(i,j).LT.0.) THEN
    19781915      ipy =  1
    19791916      dq  = - q(i,j)*cosp(j)
    … …  
    19911928      q(i,j) = (d2 - dq)*acosp(j) + tiny
    19921929      endif
    1993       END DO
    1994       END DO
     193055    continue
    19951931C
    19961932      do i=1,imr
    1997       IF(q(i,j1)<0.) THEN
     1933      IF(q(i,j1).LT.0.) THEN
    19981934      ipy =  1
    19991935      dq  = - q(i,j1)*cosp(j1)
    … …  
    20091945      j = j2
    20101946      do i=1,imr
    2011       IF(q(i,j)<0.) THEN
     1947      IF(q(i,j).LT.0.) THEN
    20121948      ipy =  1
    20131949      dq  = - q(i,j)*cosp(j)
    … …  
    20221958C
    20231959C Check Poles.
    2024       if(q(1,1)<0.) then
     1960      if(q(1,1).lt.0.) then
    20251961      dq = q(1,1)*cap1/REAL(IMR)*acosp(j1)
    20261962      do i=1,imr
    20271963      q(i,1) = 0.
    20281964      q(i,j1) = q(i,j1) + dq
    2029       if(q(i,j1)<0.) ipy = 1
    2030       enddo
    2031       endif
    2032 C
    2033       if(q(1,JNP)<0.) then
     1965      if(q(i,j1).lt.0.) ipy = 1
     1966      enddo
     1967      endif
     1968C
     1969      if(q(1,JNP).lt.0.) then
    20341970      dq = q(1,JNP)*cap1/REAL(IMR)*acosp(j2)
    20351971      do i=1,imr
    20361972      q(i,JNP) = 0.
    20371973      q(i,j2) = q(i,j2) + dq
    2038       if(q(i,j2)<0.) ipy = 1
     1974      if(q(i,j2).lt.0.) ipy = 1
    20391975      enddo
    20401976      endif
    … …  
    20521988      ipx = 0
    20531989C Copy & swap direction for vectorization.
    2054       do i=1,imr
    2055       do j=j1,j2
    2056       qtmp(j,i) = q(i,j)
    2057       END DO
    2058       END DO
    2059 C
    2060       do i=2,imr-1
    2061       do j=j1,j2
    2062       if(qtmp(j,i)<0.) then
     1990      do 25 i=1,imr
     1991      do 25 j=j1,j2
     199225    qtmp(j,i) = q(i,j)
     1993C
     1994      do 55 i=2,imr-1
     1995      do 55 j=j1,j2
     1996      if(qtmp(j,i).lt.0.) then
    20631997      ipx =  1
    20641998c west
    … …  
    20732007      qtmp(j,i) = qtmp(j,i) + d2 + tiny
    20742008      endif
    2075       END DO
    2076       END DO
     200955    continue
    20772010c
    20782011      i=1
    2079       do j=j1,j2
    2080       if(qtmp(j,i)<0.) then
     2012      do 65 j=j1,j2
     2013      if(qtmp(j,i).lt.0.) then
    20812014      ipx =  1
    20822015c west
    … …  
    20922025      qtmp(j,i) = qtmp(j,i) + d2 + tiny
    20932026      endif
    2094       END DO
     202765    continue
    20952028      i=IMR
    2096       do j=j1,j2
    2097       if(qtmp(j,i)<0.) then
     2029      do 75 j=j1,j2
     2030      if(qtmp(j,i).lt.0.) then
    20982031      ipx =  1
    20992032c west
    … …  
    21092042      qtmp(j,i) = qtmp(j,i) + d2 + tiny
    21102043      endif
    2111       END DO
    2112 C
    2113       if(ipx/=0) then
    2114       do j=j1,j2
    2115       do i=1,imr
    2116       q(i,j) = qtmp(j,i)
    2117       END DO
    2118       END DO
     204475    continue
     2045C
     2046      if(ipx.ne.0) then
     2047      do 85 j=j1,j2
     2048      do 85 i=1,imr
     204985    q(i,j) = qtmp(j,i)
    21192050      else
    21202051C
    21212052C Poles.
    2122       if(q(1,1)<0 .or. q(1,JNP)<0.) ipx = 1
     2053      if(q(1,1).lt.0. or. q(1,JNP).lt.0.) ipx = 1
    21232054      endif
    21242055      return
    … …  
    21342065      integer IC,k,i
    21352066C
    2136       do IC = 1, nc
    2137 C
    2138       do k=1,km
    2139       do i=1,im
     2067      do 4000 IC = 1, nc
     2068C
     2069      do 1000 k=1,km
     2070      do 1000 i=1,im
    21402071      qtmp(i,k) = q(i,km+1-k,IC)
    2141       END DO
    2142       END DO
    2143 C
    2144       do i=1,im*km
    2145       q(i,1,IC) = qtmp(i,1)
    2146       END DO
    2147       END DO
     20721000  continue
     2073C
     2074      do 2000 i=1,im*km
     20752000  q(i,1,IC) = qtmp(i,1)
     20764000  continue
    21482077      return
    21492078      end

  • LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90

    r5075 r5084  
    99  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    1010  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str, strIdx
    11   USE lmdz_netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
     11  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
    1212                         NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE,  NF90_NoErr
    1313  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey

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

    r5075 r5084  
    1111  USE strings_mod, ONLY: maxlen
    1212  USE infotrac, ONLY: nqtot, tracers
    13   USE lmdz_netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
     13  USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL,    &
    1414                    NF90_CLOSE,  NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER,   &
    1515                    NF90_64BIT_OFFSET
    … …  
    178178  USE infotrac, ONLY: nqtot, tracers, type_trac
    179179  USE control_mod
    180   USE lmdz_netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
     180  USE netcdf,   ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID,  &
    181181                      NF90_CLOSE, NF90_WRITE,   NF90_PUT_VAR, NF90_NoErr
    182182  USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &

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

    r5075 r5084  
    44  USE parallel_lmdz
    55  USE mod_hallo
    6   USE lmdz_netcdf, ONLY:nf90_strerror,nf90_noerr,nf90_redef,nf90_put_var,nf90_inquire_dimension,&
    7           nf90_format,nf90_inq_varid,nf90_get_var,nf90_def_var,nf90_enddef,nf90_put_att
     6  USE netcdf
    87  PRIVATE
    98  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
    … …  
    181180  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    182181!===============================================================================
    183   CALL err(NF90_DEF_VAR(ncid,var,NF90_FORMAT,did,nvarid),"inq",var)
     182#ifdef NC_DOUBLE
     183  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
     184#else
     185  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
     186#endif
    184187  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
    185188  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)

  • LMDZ6/trunk/libf/dyn3dmem/guide_loc_mod.F90

    r5072 r5084  
     1!
     2! $Id$
     3!
    14MODULE guide_loc_mod
    25
    … …  
    811  USE getparam, only: ini_getparam, fin_getparam, getpar
    912  USE Write_Field_loc
    10   use lmdz_netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
    11           nf90_inq_dimid, nf90_inquire_dimension, nf_inq_dimid, &
    12           nf_inq_dimlen, nf_enddef, nf_def_dim, nf90_put_var, nf_noerr, nf_close, nf_inq_varid, &
    13           nf_redef, nf_write, nf_unlimited, nf_float, nf_clobber, nf_64bit_offset, nf90_float, &
    14           nf_create, nf_def_var, nf_open
     13  use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     14                    nf90_inq_dimid, nf90_inquire_dimension
    1515  USE parallel_lmdz
    1616  USE pres2lev_mod, only: pres2lev
    … …  
    8181    INCLUDE "dimensions.h"
    8282    INCLUDE "paramet.h"
     83    INCLUDE "netcdf.inc"
    8384
    8485    INTEGER                :: error,ncidpl,rid,rcod
    … …  
    125126    CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage')
    126127    ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois.
    127     IF (iguide_sav>0) THEN
     128    IF (iguide_sav.GT.0) THEN
    128129       iguide_sav=day_step/iguide_sav
    129130    ELSE if (iguide_sav == 0) then
    … …  
    145146    CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage')
    146147    CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert')
    147     IF (iguide_int==0) THEN
     148    IF (iguide_int.EQ.0) THEN
    148149        iguide_int=1
    149     ELSEIF (iguide_int>0) THEN
     150    ELSEIF (iguide_int.GT.0) THEN
    150151        iguide_int=day_step/iguide_int
    151152    ELSE
    … …  
    173174! ---------------------------------------------
    174175    ncidpl=-99
    175     if (guide_plevs==1) then
    176        if (ncidpl==-99) then
     176    if (guide_plevs.EQ.1) then
     177       if (ncidpl.eq.-99) then
    177178          rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl)
    178           if (rcod/=NF_NOERR) THEN
     179          if (rcod.NE.NF_NOERR) THEN
    179180             abort_message=' Nudging error -> no file apbp.nc'
    180181             CALL abort_gcm(modname,abort_message,1)
    181182          endif
    182183       endif
    183     elseif (guide_plevs==2) then
    184        if (ncidpl==-99) then
     184    elseif (guide_plevs.EQ.2) then
     185       if (ncidpl.EQ.-99) then
    185186          rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl)
    186           if (rcod/=NF_NOERR) THEN
     187          if (rcod.NE.NF_NOERR) THEN
    187188             abort_message=' Nudging error -> no file P.nc'
    188189             CALL abort_gcm(modname,abort_message,1)
    … …  
    191192
    192193    elseif (guide_u) then
    193        if (ncidpl==-99) then
     194       if (ncidpl.eq.-99) then
    194195          rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl)
    195           if (rcod/=NF_NOERR) THEN
     196          if (rcod.NE.NF_NOERR) THEN
    196197             abort_message=' Nudging error -> no file u.nc'
    197198             CALL abort_gcm(modname,abort_message,1)
    … …  
    202203
    203204    elseif (guide_v) then
    204        if (ncidpl==-99) then
     205       if (ncidpl.eq.-99) then
    205206          rcod=nf90_open('v.nc',nf90_nowrite,ncidpl)
    206           if (rcod/=NF_NOERR) THEN
     207          if (rcod.NE.NF_NOERR) THEN
    207208             abort_message=' Nudging error -> no file v.nc'
    208209             CALL abort_gcm(modname,abort_message,1)
    … …  
    212213   
    213214    elseif (guide_T) then
    214        if (ncidpl==-99) then
     215       if (ncidpl.eq.-99) then
    215216          rcod=nf90_open('T.nc',nf90_nowrite,ncidpl)
    216           if (rcod/=NF_NOERR) THEN
     217          if (rcod.NE.NF_NOERR) THEN
    217218             abort_message=' Nudging error -> no file T.nc'
    218219             CALL abort_gcm(modname,abort_message,1)
    … …  
    223224
    224225    elseif (guide_Q) then
    225        if (ncidpl==-99) then
     226       if (ncidpl.eq.-99) then
    226227          rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl)
    227           if (rcod/=NF_NOERR) THEN
     228          if (rcod.NE.NF_NOERR) THEN
    228229             abort_message=' Nudging error -> no file hur.nc'
    229230             CALL abort_gcm(modname,abort_message,1)
    … …  
    234235    endif
    235236    error=NF_INQ_DIMID(ncidpl,'LEVEL',rid)
    236     IF (error/=NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
    237     IF (error/=NF_NOERR) THEN
     237    IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)
     238    IF (error.NE.NF_NOERR) THEN
    238239        abort_message='Nudging: error reading pressure levels'
    239240        CALL abort_gcm(modname,abort_message,1)
    … …  
    316317    ENDIF
    317318
    318     IF (guide_plevs==2) THEN
     319    IF (guide_plevs.EQ.2) THEN
    319320        ALLOCATE(pnat1(iip1,jjb_u:jje_u,nlevnc), stat = error)
    320321        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    324325    ENDIF
    325326
    326     IF (guide_P.OR.guide_plevs==1) THEN
     327    IF (guide_P.OR.guide_plevs.EQ.1) THEN
    327328        ALLOCATE(psnat1(iip1,jjb_u:jje_u), stat = error)
    328329        IF (error /= 0) CALL abort_gcm(modname,abort_message,1)
    … …  
    351352    IF (guide_T) tnat1=tnat2
    352353    IF (guide_Q) qnat1=qnat2
    353     IF (guide_plevs==2) pnat1=pnat2
    354     IF (guide_P.OR.guide_plevs==1) psnat1=psnat2
     354    IF (guide_plevs.EQ.2) pnat1=pnat2
     355    IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2
    355356
    356357  END SUBROUTINE guide_init
    … …  
    488489! Lecture des fichiers de guidage ?
    489490!-----------------------------------------------------------------------
    490     IF (iguide_read/=0) THEN
     491    IF (iguide_read.NE.0) THEN
    491492      ditau=real(itau)
    492493      dday_step=real(day_step)
    493       IF (iguide_read<0) THEN
     494      IF (iguide_read.LT.0) THEN
    494495          tau=ditau/dday_step/REAL(iguide_read)
    495496      ELSE
    … …  
    497498      ENDIF
    498499      reste=tau-AINT(tau)
    499       IF (reste==0.) THEN
    500           IF (itau_test==itau) THEN
     500      IF (reste.EQ.0.) THEN
     501          IF (itau_test.EQ.itau) THEN
    501502            write(*,*)trim(modname)//' second pass in advreel at itau=',&
    502503            itau
    … …  
    508509              IF (guide_T) tnat1(:,jjbu:jjeu,:)=tnat2(:,jjbu:jjeu,:)
    509510              IF (guide_Q) qnat1(:,jjbu:jjeu,:)=qnat2(:,jjbu:jjeu,:)
    510               IF (guide_plevs==2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)
    511               IF (guide_P.OR.guide_plevs==1) psnat1(:,jjbu:jjeu)=psnat2(:,jjbu:jjeu)
     511              IF (guide_plevs.EQ.2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)
     512              IF (guide_P.OR.guide_plevs.EQ.1) psnat1(:,jjbu:jjeu)=psnat2(:,jjbu:jjeu)
    512513!$OMP END MASTER
    513514!$OMP BARRIER
    … …  
    540541! Interpolation et conversion des champs de guidage
    541542!-----------------------------------------------------------------------
    542     IF (MOD(itau,iguide_int)==0) THEN
     543    IF (MOD(itau,iguide_int).EQ.0) THEN
    543544        CALL guide_interp(ps,teta)
    544545    ENDIF
    545546! Repartition entre 2 etats de guidage
    546     IF (iguide_read/=0) THEN
     547    IF (iguide_read.NE.0) THEN
    547548        tau=reste
    548549    ELSE
    … …  
    560561!-----------------------------------------------------------------------
    561562! Sauvegarde du guidage?
    562     f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav)
     563    f_out=((MOD(itau,iguide_sav).EQ.0).AND.guide_sav) 
    563564    IF (f_out) THEN
    564565
    … …  
    803804        IF (guide_reg) THEN
    804805            DO i=1,iim
    805                 IF (lond(i)<lon_min_g) imin(1)=i
    806                 IF (lond(i)<=lon_max_g) imax(1)=i
     806                IF (lond(i).LT.lon_min_g) imin(1)=i
     807                IF (lond(i).LE.lon_max_g) imax(1)=i
    807808            ENDDO
    808809            lond=rlonv*180./pi
    809810            DO i=1,iim
    810                 IF (lond(i)<lon_min_g) imin(2)=i
    811                 IF (lond(i)<=lon_max_g) imax(2)=i
     811                IF (lond(i).LT.lon_min_g) imin(2)=i
     812                IF (lond(i).LE.lon_max_g) imax(2)=i
    812813            ENDDO
    813814        ENDIF
    … …  
    875876        IF (guide_reg) THEN
    876877            DO i=1,iim
    877                 IF (lond(i)<lon_min_g) imin(1)=i
    878                 IF (lond(i)<=lon_max_g) imax(1)=i
     878                IF (lond(i).LT.lon_min_g) imin(1)=i
     879                IF (lond(i).LE.lon_max_g) imax(1)=i
    879880            ENDDO
    880881            lond=rlonv*180./pi
    881882            DO i=1,iim
    882                 IF (lond(i)<lon_min_g) imin(2)=i
    883                 IF (lond(i)<=lon_max_g) imax(2)=i
     883                IF (lond(i).LT.lon_min_g) imin(2)=i
     884                IF (lond(i).LE.lon_max_g) imax(2)=i
    884885            ENDDO
    885886        ENDIF
    … …  
    982983   
    983984   
    984     IF (guide_plevs==0) THEN
     985    IF (guide_plevs.EQ.0) THEN
    985986!$OMP DO
    986987        DO l=1,nlevnc
    … …  
    10481049
    10491050!    ....  Calcul de pls , pression au milieu des couches ,en Pascals
    1050     IF (guide_plevs==1) THEN
     1051    IF (guide_plevs.EQ.1) THEN
    10511052!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    10521053        DO l=1,llm
    … …  
    11271128    IF (guide_T) THEN
    11281129        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    1129         IF (guide_plevs==1) THEN
     1130        IF (guide_plevs.EQ.1) THEN
    11301131!$OMP DO
    11311132            DO l=1,nlevnc
    … …  
    11371138                ENDDO
    11381139            ENDDO
    1139         ELSE IF (guide_plevs==2) THEN
     1140        ELSE IF (guide_plevs.EQ.2) THEN
    11401141!$OMP DO
    11411142            DO l=1,nlevnc
    … …  
    11941195    IF (guide_Q) THEN
    11951196        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    1196         IF (guide_plevs==1) THEN
     1197        IF (guide_plevs.EQ.1) THEN
    11971198!$OMP DO
    11981199            DO l=1,nlevnc
    … …  
    12041205                ENDDO
    12051206            ENDDO
    1206         ELSE IF (guide_plevs==2) THEN
     1207        ELSE IF (guide_plevs.EQ.2) THEN
    12071208!$OMP DO
    12081209            DO l=1,nlevnc
    … …  
    12661267    IF (guide_u) THEN
    12671268        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    1268         IF (guide_plevs==1) THEN
     1269        IF (guide_plevs.EQ.1) THEN
    12691270!$OMP DO
    12701271            DO l=1,nlevnc
    … …  
    12801281                ENDDO
    12811282            ENDDO
    1282         ELSE IF (guide_plevs==2) THEN
     1283        ELSE IF (guide_plevs.EQ.2) THEN
    12831284!$OMP DO
    12841285            DO l=1,nlevnc
    … …  
    13341335    IF (guide_v) THEN
    13351336        ! Calcul des nouvelles valeurs des niveaux de pression du guidage
    1336         IF (guide_plevs==1) THEN
     1337        IF (guide_plevs.EQ.1) THEN
    13371338         CALL Register_Hallo_u(psnat1,1,1,2,2,1,Req)
    13381339         CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req)
    … …  
    13521353                ENDDO
    13531354            ENDDO
    1354         ELSE IF (guide_plevs==2) THEN
     1355        ELSE IF (guide_plevs.EQ.2) THEN
    13551356         CALL Register_Hallo_u(pnat1,llm,1,2,2,1,Req)
    13561357         CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req)
    … …  
    14441445            do j=jjb,jje
    14451446                do i=1,pim
    1446                     if (typ==2) then
     1447                    if (typ.eq.2) then
    14471448                       zlat=rlatu(j)*180./pi
    14481449                       zlon=rlonu(i)*180./pi
    1449                     elseif (typ==1) then
     1450                    elseif (typ.eq.1) then
    14501451                       zlat=rlatu(j)*180./pi
    14511452                       zlon=rlonv(i)*180./pi
    1452                     elseif (typ==3) then
     1453                    elseif (typ.eq.3) then
    14531454                       zlat=rlatv(j)*180./pi
    14541455                       zlon=rlonv(i)*180./pi
    … …  
    14891490            enddo
    14901491        enddo
    1491         IF (typ==2) THEN
     1492        IF (typ.EQ.2) THEN
    14921493            do j=1,jjp1
    14931494                do i=1,iim
    … …  
    14971498            enddo
    14981499        ENDIF
    1499         IF (typ==3) THEN
     1500        IF (typ.EQ.3) THEN
    15001501            do j=1,jjm
    15011502                do i=1,iip1
    … …  
    15191520            enddo
    15201521            ! Calcul de gamma
    1521             if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
     1522            if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    15221523              write(*,*)trim(modname)//' ATTENTION modele peu zoome'
    15231524              write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'
    … …  
    15261527              gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min)
    15271528              write(*,*)trim(modname)//' gamma=',gamma
    1528               if (gamma<1.e-5) then
     1529              if (gamma.lt.1.e-5) then
    15291530                write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'
    15301531                CALL abort_gcm("guide_loc_mod","stopped",1)
    … …  
    15401541        do j=jjb,jje
    15411542            do i=1,pim
    1542                 if (typ==1) then
     1543                if (typ.eq.1) then
    15431544                   dxdy_=dxdys(i,j)
    15441545                   zlat=rlatu(j)*180./pi
    1545                 elseif (typ==2) then
     1546                elseif (typ.eq.2) then
    15461547                   dxdy_=dxdyu(i,j)
    15471548                   zlat=rlatu(j)*180./pi
    1548                 elseif (typ==3) then
     1549                elseif (typ.eq.3) then
    15491550                   dxdy_=dxdyv(i,j)
    15501551                   zlat=rlatv(j)*180./pi
    15511552                endif
    1552                 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then
     1553                if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then
    15531554                ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin
    15541555                    alpha(i,j)=alphamin
    … …  
    15561557                    xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma
    15571558                    xi=min(xi,1.)
    1558                     if(lat_min_g<=zlat .and. zlat<=lat_max_g) then
     1559                    if(lat_min_g.le.zlat .and. zlat.le.lat_max_g) then
    15591560                        alpha(i,j)=xi*alphamin+(1.-xi)*alphamax
    15601561                    else
    … …  
    15751576    IMPLICIT NONE
    15761577
     1578    include "netcdf.inc"
    15771579    include "dimensions.h"
    15781580    include "paramet.h"
    … …  
    16001602         write(*,*),trim(modname)//': opening nudging files '
    16011603! Ap et Bp si Niveaux de pression hybrides
    1602          if (guide_plevs==1) then
     1604         if (guide_plevs.EQ.1) then
    16031605             write(*,*),trim(modname)//' Reading nudging on model levels'
    16041606             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1605              IF (rcode/=NF_NOERR) THEN
     1607             IF (rcode.NE.NF_NOERR) THEN
    16061608              abort_message='Nudging: error -> no file apbp.nc'
    16071609              CALL abort_gcm(modname,abort_message,1)
    16081610             ENDIF
    16091611             rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1610              IF (rcode/=NF_NOERR) THEN
     1612             IF (rcode.NE.NF_NOERR) THEN
    16111613              abort_message='Nudging: error -> no AP variable in file apbp.nc'
    16121614              CALL abort_gcm(modname,abort_message,1)
    16131615             ENDIF
    16141616             rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1615              IF (rcode/=NF_NOERR) THEN
     1617             IF (rcode.NE.NF_NOERR) THEN
    16161618              abort_message='Nudging: error -> no BP variable in file apbp.nc'
    16171619              CALL abort_gcm(modname,abort_message,1)
    … …  
    16211623         
    16221624! Pression si guidage sur niveaux P variables
    1623          if (guide_plevs==2) then
     1625         if (guide_plevs.EQ.2) then
    16241626             rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1625              IF (rcode/=NF_NOERR) THEN
     1627             IF (rcode.NE.NF_NOERR) THEN
    16261628              abort_message='Nudging: error -> no file P.nc'
    16271629              CALL abort_gcm(modname,abort_message,1)
    16281630             ENDIF
    16291631             rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1630              IF (rcode/=NF_NOERR) THEN
     1632             IF (rcode.NE.NF_NOERR) THEN
    16311633              abort_message='Nudging: error -> no PRES variable in file P.nc'
    16321634              CALL abort_gcm(modname,abort_message,1)
    16331635             ENDIF
    16341636             write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
    1635              if (ncidpl==-99) ncidpl=ncidp
     1637             if (ncidpl.eq.-99) ncidpl=ncidp
    16361638         endif
    16371639
    … …  
    16391641         if (guide_u) then
    16401642             rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1641              IF (rcode/=NF_NOERR) THEN
     1643             IF (rcode.NE.NF_NOERR) THEN
    16421644              abort_message='Nudging: error -> no file u.nc'
    16431645              CALL abort_gcm(modname,abort_message,1)
    16441646             ENDIF
    16451647             rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1646              IF (rcode/=NF_NOERR) THEN
     1648             IF (rcode.NE.NF_NOERR) THEN
    16471649              abort_message='Nudging: error -> no UWND variable in file u.nc'
    16481650              CALL abort_gcm(modname,abort_message,1)
    16491651             ENDIF
    16501652             write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
    1651              if (ncidpl==-99) ncidpl=ncidu
     1653             if (ncidpl.eq.-99) ncidpl=ncidu
    16521654
    16531655   
    16541656             status=NF90_INQ_DIMID(ncidu, "LONU", dimid)
    16551657             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    1656              IF (lendim /= iip1) THEN
     1658             IF (lendim .NE. iip1) THEN
    16571659                abort_message='dimension LONU different from iip1 in u.nc'
    16581660                CALL abort_gcm(modname,abort_message,1)
    … …  
    16611663             status=NF90_INQ_DIMID(ncidu, "LATU", dimid)
    16621664             status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim)
    1663              IF (lendim /= jjp1) THEN
     1665             IF (lendim .NE. jjp1) THEN
    16641666                abort_message='dimension LATU different from jjp1 in u.nc'
    16651667                CALL abort_gcm(modname,abort_message,1)
    … …  
    16711673         if (guide_v) then
    16721674             rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1673              IF (rcode/=NF_NOERR) THEN
     1675             IF (rcode.NE.NF_NOERR) THEN
    16741676              abort_message='Nudging: error -> no file v.nc'
    16751677              CALL abort_gcm(modname,abort_message,1)
    16761678             ENDIF
    16771679             rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1678              IF (rcode/=NF_NOERR) THEN
     1680             IF (rcode.NE.NF_NOERR) THEN
    16791681              abort_message='Nudging: error -> no VWND variable in file v.nc'
    16801682              CALL abort_gcm(modname,abort_message,1)
    16811683             ENDIF
    16821684             write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
    1683              if (ncidpl==-99) ncidpl=ncidv
     1685             if (ncidpl.eq.-99) ncidpl=ncidv
    16841686             
    16851687             status=NF90_INQ_DIMID(ncidv, "LONV", dimid)
    16861688             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
    16871689             
    1688                 IF (lendim /= iip1) THEN
     1690                IF (lendim .NE. iip1) THEN
    16891691                abort_message='dimension LONV different from iip1 in v.nc'
    16901692                CALL abort_gcm(modname,abort_message,1)
    … …  
    16941696             status=NF90_INQ_DIMID(ncidv, "LATV", dimid)
    16951697             status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim)
    1696              IF (lendim /= jjm) THEN
     1698             IF (lendim .NE. jjm) THEN
    16971699                abort_message='dimension LATV different from jjm in v.nc'
    16981700                CALL abort_gcm(modname,abort_message,1)
    … …  
    17041706         if (guide_T) then
    17051707             rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1706              IF (rcode/=NF_NOERR) THEN
     1708             IF (rcode.NE.NF_NOERR) THEN
    17071709              abort_message='Nudging: error -> no file T.nc'
    17081710              CALL abort_gcm(modname,abort_message,1)
    17091711             ENDIF
    17101712             rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1711              IF (rcode/=NF_NOERR) THEN
     1713             IF (rcode.NE.NF_NOERR) THEN
    17121714              abort_message='Nudging: error -> no AIR variable in file T.nc'
    17131715              CALL abort_gcm(modname,abort_message,1)
    17141716             ENDIF
    17151717             write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
    1716              if (ncidpl==-99) ncidpl=ncidt
     1718             if (ncidpl.eq.-99) ncidpl=ncidt
    17171719
    17181720             status=NF90_INQ_DIMID(ncidt, "LONV", dimid)
    17191721             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    1720              IF (lendim /= iip1) THEN
     1722             IF (lendim .NE. iip1) THEN
    17211723                abort_message='dimension LONV different from iip1 in T.nc'
    17221724                CALL abort_gcm(modname,abort_message,1)
    … …  
    17251727             status=NF90_INQ_DIMID(ncidt, "LATU", dimid)
    17261728             status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim)
    1727              IF (lendim /= jjp1) THEN
     1729             IF (lendim .NE. jjp1) THEN
    17281730                abort_message='dimension LATU different from jjp1 in T.nc'
    17291731                CALL abort_gcm(modname,abort_message,1)
    … …  
    17351737         if (guide_Q) then
    17361738             rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    1737              IF (rcode/=NF_NOERR) THEN
     1739             IF (rcode.NE.NF_NOERR) THEN
    17381740              abort_message='Nudging: error -> no file hur.nc'
    17391741              CALL abort_gcm(modname,abort_message,1)
    17401742             ENDIF
    17411743             rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    1742              IF (rcode/=NF_NOERR) THEN
     1744             IF (rcode.NE.NF_NOERR) THEN
    17431745              abort_message='Nudging: error -> no RH variable in file hur.nc'
    17441746              CALL abort_gcm(modname,abort_message,1)
    17451747             ENDIF
    17461748             write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    1747              if (ncidpl==-99) ncidpl=ncidQ
     1749             if (ncidpl.eq.-99) ncidpl=ncidQ
    17481750
    17491751
    17501752             status=NF90_INQ_DIMID(ncidQ, "LONV", dimid)
    17511753             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    1752              IF (lendim /= iip1) THEN
     1754             IF (lendim .NE. iip1) THEN
    17531755                abort_message='dimension LONV different from iip1 in hur.nc'
    17541756                CALL abort_gcm(modname,abort_message,1)
    … …  
    17571759             status=NF90_INQ_DIMID(ncidQ, "LATU", dimid)
    17581760             status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim)
    1759              IF (lendim /= jjp1) THEN
     1761             IF (lendim .NE. jjp1) THEN
    17601762                abort_message='dimension LATU different from jjp1 in hur.nc'
    17611763                CALL abort_gcm(modname,abort_message,1)
    … …  
    17651767         endif
    17661768! Pression de surface
    1767          if ((guide_P).OR.(guide_plevs==1)) then
     1769         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    17681770             rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    1769              IF (rcode/=NF_NOERR) THEN
     1771             IF (rcode.NE.NF_NOERR) THEN
    17701772              abort_message='Nudging: error -> no file ps.nc'
    17711773              CALL abort_gcm(modname,abort_message,1)
    17721774             ENDIF
    17731775             rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    1774              IF (rcode/=NF_NOERR) THEN
     1776             IF (rcode.NE.NF_NOERR) THEN
    17751777              abort_message='Nudging: error -> no SP variable in file ps.nc'
    17761778              CALL abort_gcm(modname,abort_message,1)
    … …  
    17791781         endif
    17801782! Coordonnee verticale
    1781          if (guide_plevs==0) then
     1783         if (guide_plevs.EQ.0) then
    17821784              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    1783               IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     1785              IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    17841786              write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    17851787         endif
    17861788! Coefs ap, bp pour calcul de la pression aux differents niveaux
    1787          IF (guide_plevs==1) THEN
    1788              status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
    1789              status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    1790          ELSEIF (guide_plevs==0) THEN
    1791              status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
     1789         IF (guide_plevs.EQ.1) THEN
     1790#ifdef NC_DOUBLE
     1791             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
     1792             status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
     1793#else
     1794             status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc)
     1795             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
     1796#endif
     1797         ELSEIF (guide_plevs.EQ.0) THEN
     1798#ifdef NC_DOUBLE
     1799             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
     1800#else
     1801             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
     1802#endif
    17921803!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
    17931804             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
    … …  
    18141825     IF (invert_y) start(2)=jjp1-jje_u+1
    18151826! Pression
    1816      if (guide_plevs==2) then
    1817          status=nf90_put_var(ncidp,varidp,pnat2,start,count)
     1827     if (guide_plevs.EQ.2) then
     1828#ifdef NC_DOUBLE
     1829         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,pnat2)
     1830#else
     1831         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,pnat2)
     1832#endif
    18181833         IF (invert_y) THEN
    18191834!           PRINT*,"Invertion impossible actuellement"
    … …  
    18251840!  Vent zonal
    18261841     if (guide_u) then
    1827          status=nf90_put_var(ncidu,varidu,unat2,start,count)
     1842#ifdef NC_DOUBLE
     1843         status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,unat2)
     1844#else
     1845         status=NF_GET_VARA_REAL(ncidu,varidu,start,count,unat2)
     1846#endif
    18281847         IF (invert_y) THEN
    18291848!           PRINT*,"Invertion impossible actuellement"
    … …  
    18371856!  Temperature
    18381857     if (guide_T) then
    1839          status=nf90_put_var(ncidt,varidt,tnat2,start,count)
     1858#ifdef NC_DOUBLE
     1859         status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,tnat2)
     1860#else
     1861         status=NF_GET_VARA_REAL(ncidt,varidt,start,count,tnat2)
     1862#endif
    18401863         IF (invert_y) THEN
    18411864!           PRINT*,"Invertion impossible actuellement"
    … …  
    18471870!  Humidite
    18481871     if (guide_Q) then
    1849          status=nf90_put_var(ncidQ,varidQ,qnat2,start,count)
     1872#ifdef NC_DOUBLE
     1873         status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,qnat2)
     1874#else
     1875         status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,qnat2)
     1876#endif
    18501877         IF (invert_y) THEN
    18511878!           PRINT*,"Invertion impossible actuellement"
    … …  
    18621889         IF (invert_y) start(2)=jjm-jje_v+1
    18631890
    1864          status=nf90_put_var(ncidv,varidv,vnat2,start,count)
     1891#ifdef NC_DOUBLE
     1892         status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,vnat2)
     1893#else
     1894         status=NF_GET_VARA_REAL(ncidv,varidv,start,count,vnat2)
     1895#endif
    18651896         IF (invert_y) THEN
    18661897!           PRINT*,"Invertion impossible actuellement"
    … …  
    18711902
    18721903!  Pression de surface
    1873      if ((guide_P).OR.(guide_plevs==1))  then
     1904     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    18741905         start(2)=jjb_u
    18751906         start(3)=timestep
    … …  
    18791910         count(4)=0
    18801911         IF (invert_y) start(2)=jjp1-jje_u+1
    1881          status=nf90_put_var(ncidps,varidps,psnat2,start,count)
     1912#ifdef NC_DOUBLE
     1913         status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,psnat2)
     1914#else
     1915         status=NF_GET_VARA_REAL(ncidps,varidps,start,count,psnat2)
     1916#endif
    18821917         IF (invert_y) THEN
    18831918!           PRINT*,"Invertion impossible actuellement"
    … …  
    18941929    IMPLICIT NONE
    18951930
     1931    include "netcdf.inc"
    18961932    include "dimensions.h"
    18971933    include "paramet.h"
    … …  
    19221958         write(*,*)trim(modname)//' : opening nudging files '
    19231959! Ap et Bp si niveaux de pression hybrides
    1924          if (guide_plevs==1) then
     1960         if (guide_plevs.EQ.1) then
    19251961           write(*,*)trim(modname)//' Reading nudging on model levels'
    19261962           rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    1927            IF (rcode/=NF_NOERR) THEN
     1963           IF (rcode.NE.NF_NOERR) THEN
    19281964             abort_message='Nudging: error -> no file apbp.nc'
    19291965           CALL abort_gcm(modname,abort_message,1)
    19301966           ENDIF
    19311967           rcode = nf90_inq_varid(ncidpl, 'AP', varidap)
    1932            IF (rcode/=NF_NOERR) THEN
     1968           IF (rcode.NE.NF_NOERR) THEN
    19331969             abort_message='Nudging: error -> no AP variable in file apbp.nc'
    19341970           CALL abort_gcm(modname,abort_message,1)
    19351971           ENDIF
    19361972           rcode = nf90_inq_varid(ncidpl, 'BP', varidbp)
    1937            IF (rcode/=NF_NOERR) THEN
     1973           IF (rcode.NE.NF_NOERR) THEN
    19381974             abort_message='Nudging: error -> no BP variable in file apbp.nc'
    19391975             CALL abort_gcm(modname,abort_message,1)
    … …  
    19421978         endif
    19431979! Pression
    1944          if (guide_plevs==2) then
     1980         if (guide_plevs.EQ.2) then
    19451981           rcode = nf90_open('P.nc', nf90_nowrite, ncidp)
    1946            IF (rcode/=NF_NOERR) THEN
     1982           IF (rcode.NE.NF_NOERR) THEN
    19471983             abort_message='Nudging: error -> no file P.nc'
    19481984             CALL abort_gcm(modname,abort_message,1)
    19491985           ENDIF
    19501986           rcode = nf90_inq_varid(ncidp, 'PRES', varidp)
    1951            IF (rcode/=NF_NOERR) THEN
     1987           IF (rcode.NE.NF_NOERR) THEN
    19521988             abort_message='Nudging: error -> no PRES variable in file P.nc'
    19531989             CALL abort_gcm(modname,abort_message,1)
    19541990           ENDIF
    19551991           write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp
    1956            if (ncidpl==-99) ncidpl=ncidp
     1992           if (ncidpl.eq.-99) ncidpl=ncidp
    19571993         endif
    19581994! Vent zonal
    19591995         if (guide_u) then
    19601996           rcode = nf90_open('u.nc', nf90_nowrite, ncidu)
    1961            IF (rcode/=NF_NOERR) THEN
     1997           IF (rcode.NE.NF_NOERR) THEN
    19621998             abort_message='Nudging: error -> no file u.nc'
    19631999             CALL abort_gcm(modname,abort_message,1)
    19642000           ENDIF
    19652001           rcode = nf90_inq_varid(ncidu, 'UWND', varidu)
    1966            IF (rcode/=NF_NOERR) THEN
     2002           IF (rcode.NE.NF_NOERR) THEN
    19672003             abort_message='Nudging: error -> no UWND variable in file u.nc'
    19682004             CALL abort_gcm(modname,abort_message,1)
    19692005           ENDIF
    19702006           write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu
    1971            if (ncidpl==-99) ncidpl=ncidu
     2007           if (ncidpl.eq.-99) ncidpl=ncidu
    19722008         endif
    19732009
    … …  
    19752011         if (guide_v) then
    19762012           rcode = nf90_open('v.nc', nf90_nowrite, ncidv)
    1977            IF (rcode/=NF_NOERR) THEN
     2013           IF (rcode.NE.NF_NOERR) THEN
    19782014             abort_message='Nudging: error -> no file v.nc'
    19792015             CALL abort_gcm(modname,abort_message,1)
    19802016           ENDIF
    19812017           rcode = nf90_inq_varid(ncidv, 'VWND', varidv)
    1982            IF (rcode/=NF_NOERR) THEN
     2018           IF (rcode.NE.NF_NOERR) THEN
    19832019             abort_message='Nudging: error -> no VWND variable in file v.nc'
    19842020             CALL abort_gcm(modname,abort_message,1)
    19852021           ENDIF
    19862022           write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv
    1987            if (ncidpl==-99) ncidpl=ncidv
     2023           if (ncidpl.eq.-99) ncidpl=ncidv
    19882024        endif
    19892025! Temperature
    19902026         if (guide_T) then
    19912027           rcode = nf90_open('T.nc', nf90_nowrite, ncidt)
    1992            IF (rcode/=NF_NOERR) THEN
     2028           IF (rcode.NE.NF_NOERR) THEN
    19932029             abort_message='Nudging: error -> no file T.nc'
    19942030             CALL abort_gcm(modname,abort_message,1)
    19952031           ENDIF
    19962032           rcode = nf90_inq_varid(ncidt, 'AIR', varidt)
    1997            IF (rcode/=NF_NOERR) THEN
     2033           IF (rcode.NE.NF_NOERR) THEN
    19982034             abort_message='Nudging: error -> no AIR variable in file T.nc'
    19992035             CALL abort_gcm(modname,abort_message,1)
    20002036           ENDIF
    20012037           write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt
    2002            if (ncidpl==-99) ncidpl=ncidt
     2038           if (ncidpl.eq.-99) ncidpl=ncidt
    20032039         endif
    20042040! Humidite
    20052041         if (guide_Q) then
    20062042           rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ)
    2007            IF (rcode/=NF_NOERR) THEN
     2043           IF (rcode.NE.NF_NOERR) THEN
    20082044             abort_message='Nudging: error -> no file hur.nc'
    20092045             CALL abort_gcm(modname,abort_message,1)
    20102046           ENDIF
    20112047           rcode = nf90_inq_varid(ncidQ, 'RH', varidQ)
    2012            IF (rcode/=NF_NOERR) THEN
     2048           IF (rcode.NE.NF_NOERR) THEN
    20132049             abort_message='Nudging: error -> no RH,variable in file hur.nc'
    20142050             CALL abort_gcm(modname,abort_message,1)
    20152051           ENDIF
    20162052           write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    2017            if (ncidpl==-99) ncidpl=ncidQ
     2053           if (ncidpl.eq.-99) ncidpl=ncidQ
    20182054         endif
    20192055! Pression de surface
    2020          if ((guide_P).OR.(guide_plevs==1)) then
     2056         if ((guide_P).OR.(guide_plevs.EQ.1)) then
    20212057           rcode = nf90_open('ps.nc', nf90_nowrite, ncidps)
    2022            IF (rcode/=NF_NOERR) THEN
     2058           IF (rcode.NE.NF_NOERR) THEN
    20232059             abort_message='Nudging: error -> no file ps.nc'
    20242060             CALL abort_gcm(modname,abort_message,1)
    20252061           ENDIF
    20262062           rcode = nf90_inq_varid(ncidps, 'SP', varidps)
    2027            IF (rcode/=NF_NOERR) THEN
     2063           IF (rcode.NE.NF_NOERR) THEN
    20282064             abort_message='Nudging: error -> no SP variable in file ps.nc'
    20292065             CALL abort_gcm(modname,abort_message,1)
    … …  
    20322068         endif
    20332069! Coordonnee verticale
    2034          if (guide_plevs==0) then
     2070         if (guide_plevs.EQ.0) then
    20352071           rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    2036            IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
     2072           IF (rcode.NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    20372073           write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    20382074         endif
    20392075! Coefs ap, bp pour calcul de la pression aux differents niveaux
    2040          if (guide_plevs==1) then
    2041              status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc])
    2042              status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc])
    2043          elseif (guide_plevs==0) THEN
    2044              status=nf90_put_var(ncidpl,varidpl,apnc,[1],[nlevnc])
     2076         if (guide_plevs.EQ.1) then
     2077#ifdef NC_DOUBLE
     2078             status=NF_GET_VARA_DOUBLE(ncidpl,varidap,1,nlevnc,apnc)
     2079             status=NF_GET_VARA_DOUBLE(ncidpl,varidbp,1,nlevnc,bpnc)
     2080#else
     2081             status=NF_GET_VARA_REAL(ncidpl,varidap,1,nlevnc,apnc)
     2082             status=NF_GET_VARA_REAL(ncidpl,varidbp,1,nlevnc,bpnc)
     2083#endif
     2084         elseif (guide_plevs.EQ.0) THEN
     2085#ifdef NC_DOUBLE
     2086             status=NF_GET_VARA_DOUBLE(ncidpl,varidpl,1,nlevnc,apnc)
     2087#else
     2088             status=NF_GET_VARA_REAL(ncidpl,varidpl,1,nlevnc,apnc)
     2089#endif
    20452090             apnc=apnc*100.! conversion en Pascals
    20462091             bpnc(:)=0.
    … …  
    20662111     IF (invert_y) start(2)=jjp1-jje_u+1
    20672112!  Pression
    2068      if (guide_plevs==2) then
    2069          status=nf90_put_var(ncidp,varidp,zu,start,count)
     2113     if (guide_plevs.EQ.2) then
     2114#ifdef NC_DOUBLE
     2115         status=NF_GET_VARA_DOUBLE(ncidp,varidp,start,count,zu)
     2116#else
     2117         status=NF_GET_VARA_REAL(ncidp,varidp,start,count,zu)
     2118#endif
    20702119         DO i=1,iip1
    20712120             pnat2(i,:,:)=zu(:,:)
    … …  
    20802129!  Vent zonal
    20812130     if (guide_u) then
    2082          status=nf90_put_var(ncidu,varidu,zu,start,count)
     2131#ifdef NC_DOUBLE
     2132         status=NF_GET_VARA_DOUBLE(ncidu,varidu,start,count,zu)
     2133#else
     2134         status=NF_GET_VARA_REAL(ncidu,varidu,start,count,zu)
     2135#endif
    20832136         DO i=1,iip1
    20842137             unat2(i,:,:)=zu(:,:)
    … …  
    20952148!  Temperature
    20962149     if (guide_T) then
    2097          status=nf90_put_var(ncidt,varidt,zu,start,count)
     2150#ifdef NC_DOUBLE
     2151         status=NF_GET_VARA_DOUBLE(ncidt,varidt,start,count,zu)
     2152#else
     2153         status=NF_GET_VARA_REAL(ncidt,varidt,start,count,zu)
     2154#endif
    20982155         DO i=1,iip1
    20992156             tnat2(i,:,:)=zu(:,:)
    … …  
    21092166!  Humidite
    21102167     if (guide_Q) then
    2111          status=nf90_put_var(ncidQ,varidQ,zu,start,count)
     2168#ifdef NC_DOUBLE
     2169         status=NF_GET_VARA_DOUBLE(ncidQ,varidQ,start,count,zu)
     2170#else
     2171         status=NF_GET_VARA_REAL(ncidQ,varidQ,start,count,zu)
     2172#endif
    21122173         DO i=1,iip1
    21132174             qnat2(i,:,:)=zu(:,:)
    … …  
    21262187         count(2)=jjnb_v
    21272188         IF (invert_y) start(2)=jjm-jje_v+1
    2128          status=nf90_put_var(ncidv,varidv,zv,start,count)
     2189#ifdef NC_DOUBLE
     2190         status=NF_GET_VARA_DOUBLE(ncidv,varidv,start,count,zv)
     2191#else
     2192         status=NF_GET_VARA_REAL(ncidv,varidv,start,count,zv)
     2193#endif
    21292194         DO i=1,iip1
    21302195             vnat2(i,:,:)=zv(:,:)
    … …  
    21402205
    21412206!  Pression de surface
    2142      if ((guide_P).OR.(guide_plevs==1))  then
     2207     if ((guide_P).OR.(guide_plevs.EQ.1))  then
    21432208         start(2)=jjb_u
    21442209         start(3)=timestep
    … …  
    21482213         count(4)=0
    21492214         IF (invert_y) start(2)=jjp1-jje_u+1
    2150          status=nf90_put_var(ncidps,varidps,zu(:,1),start,count)
     2215#ifdef NC_DOUBLE
     2216         status=NF_GET_VARA_DOUBLE(ncidps,varidps,start,count,zu(:,1))
     2217#else
     2218         status=NF_GET_VARA_REAL(ncidps,varidps,start,count,zu(:,1))
     2219#endif
    21512220         DO i=1,iip1
    21522221             psnat2(i,:)=zu(:,1)
    … …  
    21692238    USE comvert_mod, ONLY: presnivs
    21702239    use netcdf95, only: nf95_def_var, nf95_put_var
     2240    use netcdf, only: nf90_float
    21712241
    21722242    IMPLICIT NONE
    … …  
    21742244    INCLUDE "dimensions.h"
    21752245    INCLUDE "paramet.h"
     2246    INCLUDE "netcdf.inc"
    21762247    INCLUDE "comgeom2.h"
    21772248   
    … …  
    22252296   
    22262297!$OMP MASTER
    2227     IF (timestep==0) THEN
     2298    IF (timestep.EQ.0) THEN
    22282299! ----------------------------------------------
    22292300! initialisation fichier de sortie
    … …  
    22572328
    22582329! Enregistrement des variables dimensions
    2259         ierr = nf90_put_var(nid,vid_lonu,rlonu*180./pi)
    2260         ierr = nf90_put_var(nid,vid_lonv,rlonv*180./pi)
    2261         ierr = nf90_put_var(nid,vid_latu,rlatu*180./pi)
    2262         ierr = nf90_put_var(nid,vid_latv,rlatv*180./pi)
    2263         ierr = nf90_put_var(nid,vid_lev,presnivs)
    2264         ierr = nf90_put_var(nid,vid_cu,cu)
    2265         ierr = nf90_put_var(nid,vid_cv,cv)
    2266         ierr = nf90_put_var(nid,vid_au,zu)
    2267         ierr = nf90_put_var(nid,vid_av,zv)
     2330#ifdef NC_DOUBLE
     2331        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonu,rlonu*180./pi)
     2332        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lonv,rlonv*180./pi)
     2333        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latu,rlatu*180./pi)
     2334        ierr = NF_PUT_VAR_DOUBLE(nid,vid_latv,rlatv*180./pi)
     2335        ierr = NF_PUT_VAR_DOUBLE(nid,vid_lev,presnivs)
     2336        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cu,cu)
     2337        ierr = NF_PUT_VAR_DOUBLE(nid,vid_cv,cv)
     2338        ierr = NF_PUT_VAR_DOUBLE(nid,vid_au,zu)
     2339        ierr = NF_PUT_VAR_DOUBLE(nid,vid_av,zv)
     2340#else
     2341        ierr = NF_PUT_VAR_REAL(nid,vid_lonu,rlonu*180./pi)
     2342        ierr = NF_PUT_VAR_REAL(nid,vid_lonv,rlonv*180./pi)
     2343        ierr = NF_PUT_VAR_REAL(nid,vid_latu,rlatu*180./pi)
     2344        ierr = NF_PUT_VAR_REAL(nid,vid_latv,rlatv*180./pi)
     2345        ierr = NF_PUT_VAR_REAL(nid,vid_lev,presnivs)
     2346        ierr = NF_PUT_VAR_REAL(nid,vid_cu,cu)
     2347        ierr = NF_PUT_VAR_REAL(nid,vid_cv,cv)
     2348        ierr = NF_PUT_VAR_REAL(nid,vid_au,alpha_u)
     2349        ierr = NF_PUT_VAR_REAL(nid,vid_av,alpha_v)
     2350#endif
    22682351        call nf95_put_var(nid, varid_alpha_t, zt)
    22692352        call nf95_put_var(nid, varid_alpha_q, zq)
    … …  
    23552438!$OMP MASTER
    23562439
    2357     ierr = nf90_put_var(nid,varid,field_glo,start,count)
     2440#ifdef NC_DOUBLE
     2441    ierr = NF_PUT_VARA_DOUBLE(nid,varid,start,count,field_glo)
     2442#else
     2443    ierr = NF_PUT_VARA_REAL(nid,varid,start,count,field_glo)
     2444#endif
     2445
    23582446    ierr = NF_CLOSE(nid)
    23592447
    … …  
    23742462    do l=1,nl
    23752463        do i=2,iim-1
    2376             if(abs(x(i,l))>1.e10) then
     2464            if(abs(x(i,l)).gt.1.e10) then
    23772465               zz=0.5*(x(i-1,l)+x(i+1,l))
    23782466              print*,'correction ',i,l,x(i,l),zz

  • LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90

    r5075 r5084  
    2323  USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
    2424  USE readTracFiles_mod, ONLY: addPhase
    25   use lmdz_netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID,NF90_CLOSE, NF90_GET_VAR
     25  use netcdf, only : NF90_NOWRITE,NF90_OPEN,NF90_NOERR,NF90_INQ_VARID
     26  use netcdf, only : NF90_CLOSE, NF90_GET_VAR
     27
    2628
    2729  !   Author:    Frederic Hourdin      original: 15/01/93
    … …  
    153155     relief=0.
    154156     ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief)
    155      if (ierr==NF90_NOERR) THEN
     157     if (ierr.EQ.NF90_NOERR) THEN
    156158         ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid)
    157159         if (ierr==NF90_NOERR) THEN
    … …  
    255257        tetastrat=ttp*zsig**(-kappa)
    256258        tetapv=tetastrat
    257         IF ((ok_pv).AND.(zsig<0.1)) THEN
     259        IF ((ok_pv).AND.(zsig.LT.0.1)) THEN
    258260           tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g)
    259261        ENDIF

  • LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F

    r5066 r5084  
    2828       USE allocate_field_mod
    2929       USE call_dissip_mod, ONLY : call_dissip
    30        USE lmdz_call_calfis, ONLY : call_calfis
     30       USE call_calfis_mod, ONLY : call_calfis
    3131       USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq
    3232     & ,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw

  • LMDZ6/trunk/libf/dyn3dmem/leapfrog_mod.F90

    r5066 r5084  
    4444  USE integrd_mod,ONLY : integrd_allocate
    4545  USE caladvtrac_mod,ONLY : caladvtrac_allocate
    46   USE lmdz_call_calfis,ONLY : call_calfis_allocate
     46  USE call_calfis_mod,ONLY : call_calfis_allocate
    4747  USE call_dissip_mod, ONLY : call_dissip_allocate
    4848  IMPLICIT NONE

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90

    r5075 r5084  
    2121  USE etat0phys,      ONLY: etat0phys_netcdf
    2222  USE limit,          ONLY: limit_netcdf
    23   USE lmdz_netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR,    &
     23  USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR,    &
    2424         NF90_INQUIRE_DIMENSION, NF90_INQ_DIMID, NF90_INQ_VARID, NF90_GET_VAR
    2525  USE infotrac,       ONLY: init_infotrac

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/limit_netcdf.F90

    r5075 r5084  
    7171#ifndef CPP_1D
    7272  USE indice_sol_mod
    73   USE lmdz_netcdf,             ONLY: NF90_OPEN,    NF90_CREATE,  NF90_CLOSE,        &
     73  USE netcdf,             ONLY: NF90_OPEN,    NF90_CREATE,  NF90_CLOSE,        &
    7474                  NF90_DEF_DIM, NF90_DEF_VAR, NF90_PUT_VAR, NF90_PUT_ATT,      &
    75                   NF90_NOERR,   NF90_NOWRITE, NF90_GLOBAL,       &
     75                  NF90_NOERR,   NF90_NOWRITE, NF90_DOUBLE, NF90_GLOBAL,       &
    7676                  NF90_CLOBBER, NF90_ENDDEF,  NF90_UNLIMITED, NF90_FLOAT,      &
    77                   NF90_64BIT_OFFSET, NF90_FORMAT
     77                  NF90_64BIT_OFFSET
    7878  USE inter_barxy_m,      ONLY: inter_barxy
    7979  USE netcdf95,           ONLY: nf95_def_var, nf95_put_att, nf95_put_var
    … …  
    107107  INTEGER :: id_tim,  id_SST,  id_BILS, id_RUG, id_ALB
    108108  INTEGER :: id_FOCE, id_FSIC, id_FTER, id_FLIC, varid_longitude, varid_latitude
     109  INTEGER :: NF90_FORMAT
    109110  INTEGER :: ndays                   !--- Depending on the output calendar
    110111  CHARACTER(LEN=ns) :: str
    111112
    112113!--- INITIALIZATIONS -----------------------------------------------------------
     114#ifdef NC_DOUBLE
     115  NF90_FORMAT=NF90_DOUBLE
     116#else
     117  NF90_FORMAT=NF90_FLOAT
     118#endif
    113119  CALL inigeom
    114120
    … …  
    321327!     2) Dimensional variables have the same names as corresponding dimensions.
    322328!-----------------------------------------------------------------------------
    323   USE lmdz_netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, &
     329  USE netcdf, ONLY: NF90_OPEN, NF90_INQ_VARID, NF90_INQUIRE_VARIABLE, &
    324330       NF90_CLOSE, NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION, NF90_GET_VAR, &
    325331       NF90_GET_ATT
    … …  
    740746! Purpose: NetCDF errors handling.
    741747!-------------------------------------------------------------------------------
    742   USE lmdz_netcdf, ONLY : NF90_NOERR, NF90_STRERROR
     748  USE netcdf, ONLY : NF90_NOERR, NF90_STRERROR
    743749  IMPLICIT NONE
    744750!-------------------------------------------------------------------------------

  • LMDZ6/trunk/libf/filtrez/inifgn.F

    r5079 r5084  
    2828      pi = 2.* ASIN(1.)
    2929C
    30       DO i=1,iim
     30      DO 5 i=1,iim
    3131       dlonu(i)=  xprimu( i )
    3232       dlonv(i)=  xprimv( i )
    33       END DO
     33   5  CONTINUE
    3434
    35       DO i=1,iim
     35      DO 12 i=1,iim
    3636      sddv(i)   = SQRT(dlonv(i))
    3737      sddu(i)   = SQRT(dlonu(i))
    3838      unsddu(i) = 1./sddu(i)
    3939      unsddv(i) = 1./sddv(i)
    40       END DO
     40  12  CONTINUE
    4141C
    42       DO j=1,iim
    43       DO i=1,iim
     42      DO 17 j=1,iim
     43      DO 17 i=1,iim
    4444      vec(i,j)     = 0.
    4545      vec1(i,j)    = 0.
    4646      eignfnv(i,j) = 0.
    4747      eignfnu(i,j) = 0.
    48       END DO
    49       END DO
     48  17  CONTINUE
    5049c
    5150c
    5251      eignfnv(1,1)    = -1.
    5352      eignfnv(iim,1)  =  1.
    54       DO i=1,imm1
     53      DO 20 i=1,imm1
    5554      eignfnv(i+1,i+1)= -1.
    5655      eignfnv(i,i+1)  =  1.
    57       END DO
    58       DO j=1,iim
    59       DO i=1,iim
     56  20  CONTINUE
     57      DO 25 j=1,iim
     58      DO 25 i=1,iim
    6059      eignfnv(i,j) = eignfnv(i,j)/(sddu(i)*sddv(j))
    61       END DO
    62       END DO
    63       DO j=1,iim
    64       DO i=1,iim
     60  25  CONTINUE
     61      DO 30 j=1,iim
     62      DO 30 i=1,iim
    6563      eignfnu(i,j) = -eignfnv(j,i)
    66       END DO
    67       END DO
     64  30  CONTINUE
    6865c
    6966#ifdef CRAY

  • LMDZ6/trunk/libf/misc/lmdz_xios.F90

    r5066 r5084  
    1212MODULE lmdz_xios
    1313  !!!! Wrapper XIOS
    14   !! => must be replaced later by official xios wrapper when available
     14  !! => must be replaced latter by official xios wrapper when available
    1515
    1616  LOGICAL,PARAMETER :: using_xios = .FALSE.

  • LMDZ6/trunk/libf/misc/write_field.F90

    r5075 r5084  
     1!
     2! $Id$
     3!
    14module write_field
    2   USE lmdz_netcdf, ONLY: nf_sync, nf90_put_var, nf_enddef, nf_def_dim, nf_unlimited, &
    3       nf_clobber, nf90_format, nf_create, nf_def_var
    4 
    5   implicit none
     5implicit none
    66
    77  integer, parameter :: MaxWriteField = 100
    … …  
    7373    subroutine WriteField_gen(name,Field,dimx,dimy,dimz)
    7474    implicit none
     75    include 'netcdf.inc'
    7576      character(len=*) :: name
    7677      integer :: dimx,dimy,dimz
    … …  
    101102      count(4)=1
    102103
    103       status = nf90_put_var(FieldId(Index),FieldVarId(Index),Field,start,count)
     104      status = NF_PUT_VARA_DOUBLE(FieldId(Index),FieldVarId(Index),start,count,Field)
    104105      status = NF_SYNC(FieldId(Index))
    105106     
    … …  
    108109    subroutine CreateNewField(name,dimx,dimy,dimz)
    109110    implicit none
     111    include 'netcdf.inc' 
    110112      character(len=*) :: name
    111113      integer :: dimx,dimy,dimz
    … …  
    124126      status = NF_DEF_DIM(FieldId(NbField),'Z',dimz,TabDim(3))
    125127      status = NF_DEF_DIM(FieldId(NbField),'iter',NF_UNLIMITED,TabDim(4))
    126       status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF90_FORMAT,4,TabDim,FieldVarId(NbField))
     128      status = NF_DEF_VAR(FieldId(NbField),FieldName(NbField),NF_DOUBLE,4,TabDim,FieldVarId(NbField))
    127129      status = NF_ENDDEF(FieldId(NbField))
    128130
    129131    end subroutine CreateNewField
     132   
     133   
    130134   
    131135  subroutine write_field1D(name,Field)
    … …  
    281285                      //trim(int2str(pos+offset))      &   
    282286                      //'," ---> ",g22.16," | ")'
    283 ! d�pent de l'impl�mention, sur compaq, c'est necessaire
     287! dépent de l'implémention, sur compaq, c'est necessaire
    284288!            Pos=Pos+ColumnSize
    285289          endif

  • LMDZ6/trunk/libf/misc/wxios.F90

    r5075 r5084  
    7070        reformaop = "average"
    7171       
    72         IF (op=="inst(X)") THEN
     72        IF (op.EQ."inst(X)") THEN
    7373            reformaop = "instant"
    7474        END IF
    7575       
    76         IF (op=="once") THEN
     76        IF (op.EQ."once") THEN
    7777            reformaop = "once"
    7878        END IF
    7979       
    80         IF (op=="t_max(X)") THEN
     80        IF (op.EQ."t_max(X)") THEN
    8181            reformaop = "maximum"
    8282        END IF
    8383       
    84         IF (op=="t_min(X)") THEN
     84        IF (op.EQ."t_min(X)") THEN
    8585            reformaop = "minimum"
    8686        END IF
    … …  
    604604    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    605605    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
    606         USE lmdz_netcdf, only: nf90_fill_real
     606        USE netcdf, only: nf90_fill_real
    607607
    608608        IMPLICIT NONE
    … …  
    621621        def = nf90_fill_real
    622622       
    623         IF (fieldunit == " ") THEN
     623        IF (fieldunit .EQ. " ") THEN
    624624            newunit = "-"
    625625        ELSE
    … …  
    666666       
    667667        ! Ajout Abd pour NMC:
    668         IF (fid<=6) THEN
     668        IF (fid.LE.6) THEN
    669669          axis_id="presnivs"
    670670        ELSE
    … …  
    682682       
    683683        !On selectionne le bon groupe de champs:
    684         IF (fdim==2) THEN
     684        IF (fdim.EQ.2) THEN
    685685          CALL xios_get_handle("fields_2D", fieldgroup)
    686686        ELSE
    … …  
    726726            CALL xios_set_attr(field, level=field_level, enabled=.TRUE.)
    727727           
    728             IF (fdim==2) THEN
     728            IF (fdim.EQ.2) THEN
    729729                !Si c'est un champ 2D:
    730730                IF (prt_level >= 10) THEN

  • LMDZ6/trunk/libf/obsolete/wstats.F90

    r5066 r5084  
    294294! The number of dimensions 'nbdim' of the variable, as well as the IDs of
    295295! corresponding dimensions must be set (in array 'dimids').
    296 ! Upon successful definition of the variable, 'nvarid' contains the
     296! Upon successfull definition of the variable, 'nvarid' contains the
    297297! NetCDF ID of the variable.
    298298! The variables' attributes 'title' (Note that 'long_name' would be more

  • LMDZ6/trunk/libf/phylmd/Dust/condsurfc.F

    r5075 r5084  
    44     .                     lmt_omnat)
    55      USE dimphy
    6       USE lmdz_netcdf, ONLY: nf_close,nf_noerr,nf_inq_varid,nf_open,nf_nowrite,nf90_get_var
    76      IMPLICIT none
    87!
    … …  
    1110!
    1211      INCLUDE "dimensions.h"
    13 
     12      INCLUDE "netcdf.inc"
     13     
    1414      REAL lmt_bcff(klon), lmt_bcbb(klon),lmt_bc_penner(klon)
    1515      REAL lmt_omff(klon), lmt_ombb(klon)
    … …  
    2424      INTEGER debut(2),epais(2)
    2525!
    26       IF (jour<0 .OR. jour>(360-1)) THEN
    27          IF (jour>(360-1).AND.jour<=367) THEN
     26      IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
     27         IF (jour.GT.(360-1).AND.jour.LE.367) THEN
    2828           jour=360-1
    2929           print *,'JE: jour changed to jour= ',jour
    … …  
    3535!
    3636      ierr = NF_OPEN ("limitcarbon.nc", NF_NOWRITE, nid1)
    37       if (ierr/=NF_NOERR) then
     37      if (ierr.ne.NF_NOERR) then
    3838        write(6,*)' Pb d''ouverture du fichier limitbc.nc'
    3939        write(6,*)' ierr = ', ierr
    … …  
    4949!
    5050      ierr = NF_INQ_VARID (nid1, "BCFF", nvarid)
    51       ierr = nf90_get_var(nid1, nvarid, lmt_bcff, debut, epais)
     51!nhl #ifdef NC_DOUBLE
     52      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcff)
    5253!      print *,'IERR = ',ierr
    5354!      print *,'NF_NOERR = ',NF_NOERR
    5455!      print *,'debut = ',debut
    5556!      print *,'epais = ',epais
    56       IF (ierr /= NF_NOERR) THEN
     57!nhl #else
     58!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcff)
     59!nhl #endif
     60      IF (ierr .NE. NF_NOERR) THEN
    5761         PRINT*, 'Pb de lecture pour les sources BC'
    5862         CALL exit(1)
    … …  
    6165!
    6266      ierr = NF_INQ_VARID (nid1, "BCBB", nvarid)
    63       ierr = nf90_get_var(nid1, nvarid, lmt_bcbb, debut, epais)
    64       IF (ierr /= NF_NOERR) THEN
     67!nhl #ifdef NC_DOUBLE
     68      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbb)
     69!nhl #else
     70!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbb)
     71!nhl #endif
     72      IF (ierr .NE. NF_NOERR) THEN
    6573         PRINT*, 'Pb de lecture pour les sources BC-biomass'
    6674         CALL exit(1)
    … …  
    6977!
    7078      ierr = NF_INQ_VARID (nid1, "BCBL", nvarid)
    71       ierr = nf90_get_var(nid1, nvarid, lmt_bcbbl, debut, epais)
    72       IF (ierr /= NF_NOERR) THEN
     79!nhl #ifdef NC_DOUBLE
     80      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbl)
     81!nhl #else
     82!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbl)
     83!nhl #endif
     84      IF (ierr .NE. NF_NOERR) THEN
    7385         PRINT*, 'Pb de lecture pour les sources BC low'
    7486         CALL exit(1)
    … …  
    7789!
    7890      ierr = NF_INQ_VARID (nid1, "BCBH", nvarid)
    79       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh, debut, epais)
    80       IF (ierr /= NF_NOERR) THEN
     91!nhl #ifdef NC_DOUBLE
     92      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbh)
     93!nhl #else
     94!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbh)
     95!nhl #endif
     96      IF (ierr .NE. NF_NOERR) THEN
    8197         PRINT*, 'Pb de lecture pour les sources BC high'
    8298         CALL exit(1)
    … …  
    84100!
    85101      ierr = NF_INQ_VARID (nid1, "TERP", nvarid)
    86       ierr = nf90_get_var (nid1, nvarid, lmt_terp, debut, epais)
    87       IF (ierr /= NF_NOERR) THEN
     102!nhl #ifdef NC_DOUBLE
     103      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_terp)
     104!nhl #else
     105!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_terp)
     106!nhl #endif
     107      IF (ierr .NE. NF_NOERR) THEN
    88108         PRINT*, 'Pb de lecture pour les sources Terpene'
    89109         CALL exit(1)
    … …  
    92112!
    93113      ierr = NF_INQ_VARID (nid1, "BC_penner", nvarid)
    94       ierr = nf90_get_var (nid1, nvarid, lmt_bc_penner, debut,  epais)
    95       IF (ierr /= NF_NOERR) THEN
     114!nhl #ifdef NC_DOUBLE
     115      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut,
     116     .       epais, lmt_bc_penner)
     117!nhl #else
     118!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais,
     119!nhl      .       lmt_bc_penner)
     120!nhl #endif
     121      IF (ierr .NE. NF_NOERR) THEN
    96122         PRINT*, 'Pb de lecture pour les sources BC Penner'
    97123         CALL exit(1)
    … …  
    100126!
    101127      ierr = NF_INQ_VARID (nid1, "OMFF", nvarid)
    102       ierr = nf90_get_var (nid1, nvarid, lmt_omff, debut, epais)
    103       IF (ierr /= NF_NOERR) THEN
     128!nhl #ifdef NC_DOUBLE
     129      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_omff)
     130!nhl #else
     131!nhl       ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_omff)
     132!nhl #endif
     133      IF (ierr .NE. NF_NOERR) THEN
    104134         PRINT*, 'Pb de lecture pour les sources om-ifossil'
    105135         CALL exit(1)

  • LMDZ6/trunk/libf/phylmd/Dust/condsurfc_new.F

    r5075 r5084  
    66      USE mod_phys_lmdz_para
    77      USE dimphy
    8       USE lmdz_netcdf, ONLY:nf90_get_var,nf_close,nf_noerr,nf_inq_varid,nf_open,nf_nowrite
    98      IMPLICIT none
    109c
    … …  
    1312c
    1413      INCLUDE "dimensions.h"
    15 
     14      INCLUDE "netcdf.inc"
     15     
    1616      REAL lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon)
    1717      REAL lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon)
    … …  
    3636c
    3737!      IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
    38       IF (jour<0 .OR. jour>366) THEN
     38      IF (jour.LT.0 .OR. jour.GT.366) THEN
    3939         PRINT*,'Le jour demande n est pas correcte:', jour
    4040         print *,'JE: FORCED TO CONTINUE (emissions have
    … …  
    5858!
    5959      ierr = NF_OPEN ("carbon_emissions.nc", NF_NOWRITE, nid1)
    60       if (ierr/=NF_NOERR) then
     60      if (ierr.ne.NF_NOERR) then
    6161        write(6,*)' Pb d''ouverture du fichier limitbc.nc'
    6262        write(6,*)' ierr = ', ierr
    … …  
    6767!
    6868      ierr = NF_INQ_VARID (nid1, "BCFF", nvarid)
    69       ierr = nf90_get_var (nid1, nvarid, lmt_bcff_glo, debut, epais)
    70       IF (ierr /= NF_NOERR) THEN
     69      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     70     .  lmt_bcff_glo)
     71      IF (ierr .NE. NF_NOERR) THEN
    7172         PRINT*, 'Pb de lecture pour les sources BC'
    7273         CALL exit(1)
    … …  
    7879!
    7980      ierr = NF_INQ_VARID (nid1, "BCNFF", nvarid)
    80       ierr = nf90_get_var (nid1, nvarid, lmt_bcnff_glo, debut, epais)
    81       IF (ierr /= NF_NOERR) THEN
     81      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     82     .    lmt_bcnff_glo)
     83      IF (ierr .NE. NF_NOERR) THEN
    8284         PRINT*, 'Pb de lecture pour les sources BC'
    8385         CALL exit(1)
    … …  
    8789!
    8890      ierr = NF_INQ_VARID (nid1, "BCBBL", nvarid)
    89       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbl_glo, debut, epais)
    90       IF (ierr /= NF_NOERR) THEN
     91      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     92     .  lmt_bcbbl_glo)
     93      IF (ierr .NE. NF_NOERR) THEN
    9194         PRINT*, 'Pb de lecture pour les sources BC low'
    9295         CALL exit(1)
    … …  
    9699!
    97100      ierr = NF_INQ_VARID (nid1, "BCBBH", nvarid)
    98       ierr = nf90_get_var (nid1, nvarid, lmt_bcbbh_glo, debut, epais)
    99       IF (ierr /= NF_NOERR) THEN
     101      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     102     .      lmt_bcbbh_glo)
     103      IF (ierr .NE. NF_NOERR) THEN
    100104         PRINT*, 'Pb de lecture pour les sources BC high'
    101105         CALL exit(1)
    … …  
    105109!
    106110      ierr = NF_INQ_VARID (nid1, "BCBA", nvarid)
    107       ierr = nf90_get_var (nid1, nvarid, lmt_bcba_glo, debut, epais)
    108       IF (ierr /= NF_NOERR) THEN
     111      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     112     .   lmt_bcba_glo)
     113      IF (ierr .NE. NF_NOERR) THEN
    109114         PRINT*, 'Pb de lecture pour les sources BC'
    110115         CALL exit(1)
    … …  
    120125!
    121126      ierr = NF_INQ_VARID (nid1, "OMFF", nvarid)
    122       ierr = nf90_get_var (nid1, nvarid, lmt_omff_glo, debut, epais)
    123       IF (ierr /= NF_NOERR) THEN
     127      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     128     .  lmt_omff_glo)
     129      IF (ierr .NE. NF_NOERR) THEN
    124130         PRINT*, 'Pb de lecture pour les sources OM'
    125131         CALL exit(1)
    … …  
    129135!
    130136      ierr = NF_INQ_VARID (nid1, "OMNFF", nvarid)
    131       ierr = nf90_get_var (nid1, nvarid, lmt_omnff_glo, debut, epais)
    132       IF (ierr /= NF_NOERR) THEN
     137      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     138     .   lmt_omnff_glo)
     139      IF (ierr .NE. NF_NOERR) THEN
    133140         PRINT*, 'Pb de lecture pour les sources OM'
    134141         CALL exit(1)
    … …  
    138145!
    139146      ierr = NF_INQ_VARID (nid1, "OMBBL", nvarid)
    140       ierr = nf90_get_var (nid1, nvarid, lmt_ombbl_glo, debut, epais)
    141       IF (ierr /= NF_NOERR) THEN
     147      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     148     .  lmt_ombbl_glo)
     149      IF (ierr .NE. NF_NOERR) THEN
    142150         PRINT*, 'Pb de lecture pour les sources OM low'
    143151         CALL exit(1)
    … …  
    147155!
    148156      ierr = NF_INQ_VARID (nid1, "OMBBH", nvarid)
    149       ierr = nf90_get_var (nid1, nvarid, lmt_ombbh_glo, debut, epais)
    150       IF (ierr /= NF_NOERR) THEN
     157      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     158     .  lmt_ombbh_glo)
     159      IF (ierr .NE. NF_NOERR) THEN
    151160         PRINT*, 'Pb de lecture pour les sources OM high'
    152161         CALL exit(1)
    … …  
    156165!
    157166      ierr = NF_INQ_VARID (nid1, "OMBA", nvarid)
    158       ierr = nf90_get_var (nid1, nvarid, lmt_omba_glo, debut, epais)
    159       IF (ierr /= NF_NOERR) THEN
     167      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     168     .   lmt_omba_glo)
     169      IF (ierr .NE. NF_NOERR) THEN
    160170         PRINT*, 'Pb de lecture pour les sources OM ship'
    161171         CALL exit(1)
    … …  
    165175!
    166176      ierr = NF_INQ_VARID (nid1, "TERP", nvarid)
    167       ierr = nf90_get_var (nid1, nvarid, lmt_terp_glo, debut, epais)
    168       IF (ierr /= NF_NOERR) THEN
     177      ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais,
     178     .  lmt_terp_glo)
     179      IF (ierr .NE. NF_NOERR) THEN
    169180         PRINT*, 'Pb de lecture pour les sources Terpene'
    170181         CALL exit(1)

  • LMDZ6/trunk/libf/phylmd/Dust/condsurfs.F

    r5075 r5084  
    44     .                     lmt_dmsbio, lmt_h2sbio, lmt_dms, lmt_dmsconc)
    55       USE dimphy
    6        USE lmdz_netcdf, ONLY:nf_close,nf_noerr,nf_inq_varid,nf_open,nf_nowrite,nf90_get_var
    76      IMPLICIT none
    87c
    … …  
    1110c
    1211      INCLUDE "dimensions.h"
     12      INCLUDE "netcdf.inc"
    1313c
    1414      REAL lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon)
    … …  
    2424      INTEGER debut(2),epais(2)
    2525c
    26       IF (jour<0 .OR. jour>(360-1)) THEN
    27          IF ((jour>(360-1)) .AND. (jour<=367)) THEN
     26      IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN
     27         IF ((jour.GT.(360-1)) .AND. (jour.LE.367)) THEN
    2828           jour=360-1
    2929           print *,'JE: jour changed to jour= ',jour
    … …  
    3535c
    3636      ierr = NF_OPEN ("limitsoufre.nc", NF_NOWRITE, nid)
    37       if (ierr/=NF_NOERR) then
     37      if (ierr.ne.NF_NOERR) then
    3838        write(6,*)' Pb d''ouverture du fichier limitsoufre.nc'
    3939        write(6,*)' ierr = ', ierr
    … …  
    4848c
    4949      ierr = NF_INQ_VARID (nid, "VOLC", nvarid)
    50       ierr = nf90_get_var(nid, nvarid, lmt_so2volc, debut, epais)
    51       IF (ierr /= NF_NOERR) THEN
     50cnhl #ifdef NC_DOUBLE
     51      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2volc)
     52cnhl #else
     53cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2volc)
     54cnhl #endif
     55      IF (ierr .NE. NF_NOERR) THEN
    5256         PRINT*, 'Pb de lecture pour les sources so2 volcan'
    5357         CALL exit(1)
    … …  
    5559c
    5660      ierr = NF_INQ_VARID (nid, "ALTI", nvarid)
    57       ierr = nf90_get_var(nid, nvarid, lmt_altvolc, debut, epais)
    58       IF (ierr /= NF_NOERR) THEN
     61cnhl #ifdef NC_DOUBLE
     62      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_altvolc)
     63cnhl #else
     64cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_altvolc)
     65cnhl #endif
     66      IF (ierr .NE. NF_NOERR) THEN
    5967         PRINT*, 'Pb de lecture pour les altitudes volcan'
    6068         CALL exit(1)
    … …  
    6472c
    6573      ierr = NF_INQ_VARID (nid, "SO2ED95L", nvarid)
    66       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
    67       IF (ierr /= NF_NOERR) THEN
     74cnhl #ifdef NC_DOUBLE
     75      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2b)
     76cnhl #else
     77cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2b)
     78cnhl #endif
     79      IF (ierr .NE. NF_NOERR) THEN
    6880         PRINT*, 'Pb de lecture pour les sources so2 edgar low'
    6981         CALL exit(1)
    … …  
    7183c
    7284      ierr = NF_INQ_VARID (nid, "SO2ED95H", nvarid)
    73       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
    74       IF (ierr /= NF_NOERR) THEN
     85cnhl #ifdef NC_DOUBLE
     86      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2h)
     87cnhl #else
     88cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2h)
     89cnhl #endif
     90      IF (ierr .NE. NF_NOERR) THEN
    7591         PRINT*, 'Pb de lecture pour les sources so2 edgar high'
    7692         CALL exit(1)
    … …  
    8096c
    8197      ierr = NF_INQ_VARID (nid, "SO2H", nvarid)
    82       ierr = nf90_get_var(nid, nvarid, lmt_so2h, debut, epais)
    83       IF (ierr /= NF_NOERR) THEN
     98cnhl #ifdef NC_DOUBLE
     99      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2h)
     100cnhl #else
     101cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2h)
     102cnhl #endif
     103      IF (ierr .NE. NF_NOERR) THEN
    84104         PRINT*, 'Pb de lecture pour les sources so2 haut'
    85105         CALL exit(1)
    … …  
    87107c
    88108      ierr = NF_INQ_VARID (nid, "SO2B", nvarid)
    89       ierr = nf90_get_var(nid, nvarid, lmt_so2b, debut, epais)
    90       IF (ierr /= NF_NOERR) THEN
     109cnhl #ifdef NC_DOUBLE
     110      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2b)
     111cnhl #else
     112cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2b)
     113cnhl #endif
     114      IF (ierr .NE. NF_NOERR) THEN
    91115         PRINT*, 'Pb de lecture pour les sources so2 bas'
    92116         CALL exit(1)
    … …  
    96120c
    97121      ierr = NF_INQ_VARID (nid, "SO2BB", nvarid)
    98       ierr = nf90_get_var(nid, nvarid, lmt_so2bb, debut, epais)
    99       IF (ierr /= NF_NOERR) THEN
     122cnhl #ifdef NC_DOUBLE
     123      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2bb)
     124cnhl #else
     125cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2bb)
     126cnhl #endif
     127      IF (ierr .NE. NF_NOERR) THEN
    100128         PRINT*, 'Pb de lecture pour les sources so2 bb'
    101129         CALL exit(1)
    … …  
    103131c
    104132      ierr = NF_INQ_VARID (nid, "SO2BA", nvarid)
    105       ierr = nf90_get_var(nid, nvarid, lmt_so2ba, debut, epais)
    106       IF (ierr /= NF_NOERR) THEN
     133cnhl #ifdef NC_DOUBLE
     134      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2ba)
     135cnhl #else
     136cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2ba)
     137cnhl #endif
     138      IF (ierr .NE. NF_NOERR) THEN
    107139         PRINT*, 'Pb de lecture pour les sources so2 bateau'
    108140         CALL exit(1)
    … …  
    110142c
    111143      ierr = NF_INQ_VARID (nid, "DMSB", nvarid)
    112       ierr = nf90_get_var(nid, nvarid, lmt_dmsbio, debut, epais)
    113       IF (ierr /= NF_NOERR) THEN
     144cnhl #ifdef NC_DOUBLE
     145      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dmsbio)
     146cnhl #else
     147cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsbio)
     148cnhl #endif
     149      IF (ierr .NE. NF_NOERR) THEN
    114150         PRINT*, 'Pb de lecture pour les sources dms bio'
    115151         CALL exit(1)
    … …  
    117153c
    118154      ierr = NF_INQ_VARID (nid, "H2SB", nvarid)
    119       ierr = nf90_get_var(nid, nvarid, lmt_h2sbio, debut, epais)
    120       IF (ierr /= NF_NOERR) THEN
     155cnhl #ifdef NC_DOUBLE
     156      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_h2sbio)
     157cnhl #else
     158cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_h2sbio)
     159cnhl #endif
     160      IF (ierr .NE. NF_NOERR) THEN
    121161         PRINT*, 'Pb de lecture pour les sources h2s bio'
    122162         CALL exit(1)
    123163      ENDIF
    124164c
    125       IF (flag_dms==1) THEN
     165      IF (flag_dms.EQ.1) THEN
    126166c
    127167      ierr = NF_INQ_VARID (nid, "DMSL", nvarid)
    128       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
    129       IF (ierr /= NF_NOERR) THEN
     168cnhl #ifdef NC_DOUBLE
     169      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dms)
     170cnhl #else
     171cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dms)
     172cnhl #endif
     173      IF (ierr .NE. NF_NOERR) THEN
    130174         PRINT*, 'Pb de lecture pour les sources dms liss'
    131175         CALL exit(1)
    132176      ENDIF
    133177c
    134       ELSEIF (flag_dms==2) THEN
     178      ELSEIF (flag_dms.EQ.2) THEN
    135179c
    136180      ierr = NF_INQ_VARID (nid, "DMSW", nvarid)
    137       ierr = nf90_get_var(nid, nvarid, lmt_dms, debut, epais)
    138       IF (ierr /= NF_NOERR) THEN
     181cnhl #ifdef NC_DOUBLE
     182      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dms)
     183cnhl #else
     184cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dms)
     185cnhl #endif
     186      IF (ierr .NE. NF_NOERR) THEN
    139187         PRINT*, 'Pb de lecture pour les sources dms wann'
    140188         CALL exit(1)
    141189      ENDIF
    142190c
    143       ELSEIF (flag_dms==3) THEN
     191      ELSEIF (flag_dms.EQ.3) THEN
    144192c
    145193      ierr = NF_INQ_VARID (nid, "DMSC1", nvarid)
    146       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    147       IF (ierr /= NF_NOERR) THEN
     194cnhl #ifdef NC_DOUBLE
     195      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     196cnhl #else
     197cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     198cnhl #endif
     199      IF (ierr .NE. NF_NOERR) THEN
    148200         PRINT*, 'Pb de lecture pour les sources dmsconc old'
    149201         CALL exit(1)
    150202      ENDIF
    151203c
    152       ELSEIF (flag_dms==4) THEN
     204      ELSEIF (flag_dms.EQ.4) THEN
    153205c
    154206      ierr = NF_INQ_VARID (nid, "DMSC2", nvarid)
    155       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    156       IF (ierr /= NF_NOERR) THEN
     207cnhl #ifdef NC_DOUBLE
     208      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     209cnhl #else
     210cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     211cnhl #endif
     212      IF (ierr .NE. NF_NOERR) THEN
    157213         PRINT*, 'Pb de lecture pour les sources dms conc 2'
    158214         CALL exit(1)
    159215      ENDIF
    160216c
    161       ELSEIF (flag_dms==5) THEN
     217      ELSEIF (flag_dms.EQ.5) THEN
    162218c
    163219      ierr = NF_INQ_VARID (nid, "DMSC3", nvarid)
    164       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    165       IF (ierr /= NF_NOERR) THEN
     220cnhl #ifdef NC_DOUBLE
     221      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     222cnhl #else
     223cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     224cnhl #endif
     225      IF (ierr .NE. NF_NOERR) THEN
    166226         PRINT*, 'Pb de lecture pour les sources dms conc 3'
    167227         CALL exit(1)
    168228      ENDIF
    169229c
    170       ELSEIF (flag_dms==6) THEN
     230      ELSEIF (flag_dms.EQ.6) THEN
    171231c
    172232      ierr = NF_INQ_VARID (nid, "DMSC4", nvarid)
    173       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    174       IF (ierr /= NF_NOERR) THEN
     233cnhl #ifdef NC_DOUBLE
     234      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     235cnhl #else
     236cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     237cnhl #endif
     238      IF (ierr .NE. NF_NOERR) THEN
    175239         PRINT*, 'Pb de lecture pour les sources dms conc 4'
    176240         CALL exit(1)
    177241      ENDIF
    178242c
    179       ELSEIF (flag_dms==7) THEN
     243      ELSEIF (flag_dms.EQ.7) THEN
    180244c
    181245      ierr = NF_INQ_VARID (nid, "DMSC5", nvarid)
    182       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    183       IF (ierr /= NF_NOERR) THEN
     246cnhl #ifdef NC_DOUBLE
     247      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     248cnhl #else
     249cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     250cnhl #endif
     251      IF (ierr .NE. NF_NOERR) THEN
    184252         PRINT*, 'Pb de lecture pour les sources dms conc 5'
    185253         CALL exit(1)
    186254      ENDIF
    187255c
    188       ELSEIF (flag_dms==8) THEN
     256      ELSEIF (flag_dms.EQ.8) THEN
    189257c
    190258      ierr = NF_INQ_VARID (nid, "DMSC6", nvarid)
    191       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    192       IF (ierr /= NF_NOERR) THEN
     259cnhl #ifdef NC_DOUBLE
     260      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     261cnhl #else
     262cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     263cnhl #endif
     264      IF (ierr .NE. NF_NOERR) THEN
    193265         PRINT*, 'Pb de lecture pour les sources dms conc 6'
    194266         CALL exit(1)
    195267      ENDIF
    196268c
    197       ELSEIF (flag_dms==9) THEN
     269      ELSEIF (flag_dms.EQ.9) THEN
    198270c
    199271      ierr = NF_INQ_VARID (nid, "DMSC7", nvarid)
    200       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    201       IF (ierr /= NF_NOERR) THEN
     272cnhl #ifdef NC_DOUBLE
     273      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     274cnhl #else
     275cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     276cnhl #endif
     277      IF (ierr .NE. NF_NOERR) THEN
    202278         PRINT*, 'Pb de lecture pour les sources dms conc 7'
    203279         CALL exit(1)
    204280      ENDIF
    205281c
    206       ELSEIF (flag_dms==10) THEN
     282      ELSEIF (flag_dms.EQ.10) THEN
    207283c
    208284      ierr = NF_INQ_VARID (nid, "DMSC8", nvarid)
    209       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc, debut, epais)
    210       IF (ierr /= NF_NOERR) THEN
     285cnhl #ifdef NC_DOUBLE
     286      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc)
     287cnhl #else
     288cnhl       ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc)
     289cnhl #endif
     290      IF (ierr .NE. NF_NOERR) THEN
    211291         PRINT*, 'Pb de lecture pour les sources dms conc 8'
    212292         CALL exit(1)
    … …  
    222302      ierr = NF_CLOSE(nid)
    223303c
    224       IF (flag_dms<=2) THEN
     304      IF (flag_dms.LE.2) THEN
    225305      DO i=1, klon
    226306         lmt_dmsconc(i)=0.0

  • LMDZ6/trunk/libf/phylmd/Dust/condsurfs_new.F

    r5075 r5084  
    99      USE mod_phys_lmdz_para
    1010      USE dimphy
    11       USE lmdz_netcdf, ONLY: nf90_get_var,nf_inq_varid,nf_close,nf_noerr,nf_open,nf_nowrite
    1211      IMPLICIT none
    1312c
    … …  
    1615c
    1716      INCLUDE "dimensions.h"
     17      INCLUDE "netcdf.inc"
    1818c
    1919      REAL lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon)
    … …  
    4040      INTEGER debut(2),epais(2)
    4141c
    42       IF (jour<0 .OR. jour>(366-1)) THEN
     42      IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN
    4343         PRINT*,'Le jour demande n est pas correcte:', jour
    4444         print *,'JE: FORCED TO CONTINUE (emissions have
    … …  
    6262!
    6363      ierr = NF_OPEN ("sulphur_emissions_antro.nc", NF_NOWRITE, nid)
    64       if (ierr/=NF_NOERR) then
     64      if (ierr.ne.NF_NOERR) then
    6565        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_antro'
    6666        write(6,*)' ierr = ', ierr
    … …  
    7272!
    7373      ierr = NF_INQ_VARID (nid, "SO2FF_LOW", nvarid)
    74       ierr = nf90_get_var(nid, nvarid, lmt_so2b_glo, debut, epais)
    75       IF (ierr /= NF_NOERR) THEN
     74      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2b_glo)
     75      IF (ierr .NE. NF_NOERR) THEN
    7676        PRINT*, 'Pb de lecture pour les sources so2 low'
    7777        print *,'JE klon, jour, debut ,epais ',klon_glo,jour,debut,epais
    … …  
    8484!
    8585      ierr = NF_INQ_VARID (nid, "SO2FF_HIGH", nvarid)
    86       ierr = nf90_get_var(nid, nvarid, lmt_so2h_glo, debut, epais)
    87       IF (ierr /= NF_NOERR) THEN
     86      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2h_glo)
     87      IF (ierr .NE. NF_NOERR) THEN
    8888        PRINT*, 'Pb de lecture pour les sources so2 high'
    8989        CALL exit(1)
    … …  
    9393!
    9494      ierr = NF_INQ_VARID (nid, "SO2BBH", nvarid)
    95       ierr = nf90_get_var(nid, nvarid,  lmt_so2bb_h_glo, debut, epais)
    96       IF (ierr /= NF_NOERR) THEN
     95      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,
     96     . epais, lmt_so2bb_h_glo)
     97      IF (ierr .NE. NF_NOERR) THEN
    9798        PRINT*, 'Pb de lecture pour les sources so2 BB high'
    9899        CALL exit(1)
    … …  
    102103!
    103104      ierr = NF_INQ_VARID (nid, "SO2BBL", nvarid)
    104       ierr = nf90_get_var(nid, nvarid,  lmt_so2bb_l_glo, debut, epais)
    105       IF (ierr /= NF_NOERR) THEN
     105      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,
     106     . epais, lmt_so2bb_l_glo)
     107      IF (ierr .NE. NF_NOERR) THEN
    106108        PRINT*, 'Pb de lecture pour les sources so2 BB low'
    107109        CALL exit(1)
    … …  
    111113!
    112114      ierr = NF_INQ_VARID (nid, "SO2BA", nvarid)
    113       ierr = nf90_get_var(nid, nvarid, lmt_so2ba_glo, debut, epais)
    114       IF (ierr /= NF_NOERR) THEN
     115      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_so2ba_glo)
     116      IF (ierr .NE. NF_NOERR) THEN
    115117        PRINT*, 'Pb de lecture pour les sources so2 ship'
    116118        CALL exit(1)
    … …  
    120122!
    121123      ierr = NF_INQ_VARID (nid, "SO2NFF", nvarid)
    122       ierr = nf90_get_var(nid, nvarid, lmt_so2nff_glo, debut, epais)
    123       IF (ierr /= NF_NOERR) THEN
     124      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
     125     .  lmt_so2nff_glo)
     126      IF (ierr .NE. NF_NOERR) THEN
    124127        PRINT*, 'Pb de lecture pour les sources so2 non FF'
    125128        CALL exit(1)
    … …  
    132135!=======================================================================
    133136      ierr = NF_OPEN ("sulphur_emissions_nat.nc", NF_NOWRITE, nid)
    134       if (ierr/=NF_NOERR) then
     137      if (ierr.ne.NF_NOERR) then
    135138        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_nat'
    136139        write(6,*)' ierr = ', ierr
    … …  
    141144c
    142145      ierr = NF_INQ_VARID (nid, "DMSB", nvarid)
    143       ierr = nf90_get_var(nid, nvarid, lmt_dmsbio_glo, debut, epais)
    144       IF (ierr /= NF_NOERR) THEN
     146      ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_dmsbio_glo)
     147      IF (ierr .NE. NF_NOERR) THEN
    145148         PRINT*, 'Pb de lecture pour les sources dms bio'
    146149         CALL exit(1)
    … …  
    150153c
    151154      ierr = NF_INQ_VARID (nid, "H2SB", nvarid)
    152       ierr = nf90_get_var(nid, nvarid, lmt_h2sbio_glo, debut, epais)
    153       IF (ierr /= NF_NOERR) THEN
     155      ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_h2sbio_glo)
     156      IF (ierr .NE. NF_NOERR) THEN
    154157         PRINT*, 'Pb de lecture pour les sources h2s bio'
    155158         CALL exit(1)
    … …  
    158161c Ocean surface concentration of dms (emissions are computed later)
    159162c
    160       IF (flag_dms==4) THEN
     163      IF (flag_dms.EQ.4) THEN
    161164c
    162165      ierr = NF_INQ_VARID (nid, "DMSC2", nvarid)
    163       ierr = nf90_get_var(nid, nvarid, lmt_dmsconc_glo, debut, epais)
    164       IF (ierr /= NF_NOERR) THEN
     166      ierr = NF_GET_VARA_DOUBLE (nid,nvarid,debut,epais,lmt_dmsconc_glo)
     167      IF (ierr .NE. NF_NOERR) THEN
    165168         PRINT*, 'Pb de lecture pour les sources dms conc 2'
    166169         CALL exit(1)
    … …  
    187190      print *,' Jour = ',jour
    188191      ierr = NF_OPEN ("sulphur_emissions_volc.nc", NF_NOWRITE, nid)
    189       if (ierr/=NF_NOERR) then
     192      if (ierr.ne.NF_NOERR) then
    190193        write(6,*)' Pb d''ouverture du fichier sulphur_emissions_volc'
    191194        write(6,*)' ierr = ', ierr
    … …  
    197200!      ierr = NF_INQ_VARID (nid, "VOLC", nvarid)
    198201      ierr = NF_INQ_VARID (nid, "flx_volc_cont", nvarid)
    199       ierr = nf90_get_var(nid, nvarid, lmt_so2volc_cont_glo, debut, epais)
    200       IF (ierr /= NF_NOERR) THEN
     202      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
     203     .                           lmt_so2volc_cont_glo)
     204      IF (ierr .NE. NF_NOERR) THEN
    201205         PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)'
    202206         CALL exit(1)
    … …  
    210214!      ierr = NF_INQ_VARID (nid, "ALTI", nvarid)
    211215      ierr = NF_INQ_VARID (nid, "flx_volc_altcont", nvarid)
    212       ierr = nf90_get_var(nid, nvarid, lmt_altvolc_cont_glo, debut, epais)
    213       IF (ierr /= NF_NOERR) THEN
     216      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
     217     .                           lmt_altvolc_cont_glo)
     218      IF (ierr .NE. NF_NOERR) THEN
    214219         PRINT*, 'Pb de lecture pour les altitudes volcan (cont)'
    215220         CALL exit(1)
    … …  
    219224c
    220225      ierr = NF_INQ_VARID (nid, "flx_volc_expl", nvarid)
    221       ierr = nf90_get_var(nid, nvarid, lmt_so2volc_expl_glo, debut, epais)
    222       IF (ierr /= NF_NOERR) THEN
     226      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
     227     .                           lmt_so2volc_expl_glo)
     228      IF (ierr .NE. NF_NOERR) THEN
    223229         PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)'
    224230         CALL exit(1)
    … …  
    231237c
    232238      ierr = NF_INQ_VARID (nid, "flx_volc_altexpl", nvarid)
    233       ierr = nf90_get_var(nid, nvarid, lmt_altvolc_expl_glo, debut, epais)
    234       IF (ierr /= NF_NOERR) THEN
     239      ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,
     240     .                           lmt_altvolc_expl_glo)
     241      IF (ierr .NE. NF_NOERR) THEN
    235242         PRINT*, 'Pb de lecture pour les altitudes volcan'
    236243         CALL exit(1)

  • LMDZ6/trunk/libf/phylmd/Dust/phys_output_write_spl_mod.F90

    r5075 r5084  
    390390    USE ioipsl, ONLY: histend, histsync
    391391    USE iophy, ONLY: set_itau_iophy, histwrite_phy
    392     USE lmdz_netcdf, ONLY: nf90_fill_real
     392    USE netcdf, ONLY: nf90_fill_real
    393393    ! ug Pour les sorties XIOS
    394394    USE lmdz_xios, ONLY: xios_update_calendar, using_xios

  • LMDZ6/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90

    r5075 r5084  
    14411441       call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1)
    14421442          endif
    1443           if ( (id_codu <= 0) .or. ( id_fine<=0)  ) then
     1443          if ( (id_codu .le. 0) .or. ( id_fine.le.0)  ) then 
    14441444          call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1',1)
    14451445          endif
    … …  
    24372437      ENDDO
    24382438      ENDDO
    2439       IF (iflag_conv==2) THEN
     2439      IF (iflag_conv.EQ.2) THEN
    24402440! Tiedke
    24412441      CALL cltrac_spl(pdtphys,coefh,yu1,yv1,t_seri,tmp_var,  &
    24422442                 aux_var2,paprs,pplay,aux_var3)
    24432443
    2444       ELSE IF (iflag_conv>=3) THEN
     2444      ELSE IF (iflag_conv.GE.3) THEN
    24452445!KE
    24462446      CALL cltrac(pdtphys, coefh,t_seri,tmp_var,aux_var2,paprs,pplay,  &
    … …  
    24942494
    24952495
    2496       IF (iflag_conv>=3) THEN
     2496      IF (iflag_conv.GE.3) THEN
    24972497
    24982498      IF (logitime) THEN
    … …  
    27862786
    27872787
    2788       IF (iflag_conv==2) THEN
     2788      IF (iflag_conv.EQ.2) THEN
    27892789
    27902790      IF (logitime) THEN
    … …  
    28392839      print *,'iflag_conv bef incloud',iflag_conv
    28402840
    2841         IF (iflag_conv==2) THEN
     2841        IF (iflag_conv.EQ.2) THEN
    28422842! Tiedke
    28432843      CALL incloud_scav(.false.,qmin,qmax,masse,henry,kk,prfl,          &
    … …  
    28772877!     .                                  his_dhbclsc,his_dhbccon,tr_seri)
    28782878
    2879         IF (iflag_conv==2) THEN
     2879        IF (iflag_conv.EQ.2) THEN
    28802880! Tiedke
    28812881
    … …  
    29912991!     .                                                 dtrconv,tr_seri)
    29922992! -------------------------------------------------------------     
    2993         IF (iflag_conv==2) THEN
     2993        IF (iflag_conv.EQ.2) THEN
    29942994! Tiedke
    29952995         CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u,  &
    … …  
    30003000         ENDDO
    30013001
    3002         ELSE IF (iflag_conv>=3) THEN
     3002        ELSE IF (iflag_conv.GE.3) THEN
    30033003! KE
    30043004         print *,'JE: KE in phytracr_spl'
    … …  
    31643164
    31653165
    3166        IF (iflag_conv>=3) THEN
     3166       IF (iflag_conv.GE.3) THEN
    31673167       IF (logitime) THEN
    31683168       CALL SYSTEM_CLOCK(COUNT=clock_start)
    … …  
    31953195       ql_incl = ql_incloud_ref
    31963196! choix du lessivage
    3197       IF (iflag_lscav == 3 .OR. iflag_lscav == 4) THEN
     3197      IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN
    31983198      !IF (.false.) THEN  ! test #DFB (Binta) sans lsc_scav_spl
    31993199        print *,'JE iflag_lscav',iflag_lscav
    … …  
    33623362      CALL satellite_out_spla(jD_cur,jH_cur,pdtphys,rlat,rlon,   &
    33633363                              masque_aqua_cur, masque_terra_cur )
    3364       IF (jH_cur-pdtphys/86400. < 0.) THEN
     3364      IF (jH_cur-pdtphys/86400. .LT. 0.) THEN
    33653365       !new utc day: put in 0 everything
    33663366!JE20150518<<
    … …  
    34703470      ENDDO
    34713471
    3472       IF (jH_cur+pdtphys/86400. >= 1.) THEN
     3472      IF (jH_cur+pdtphys/86400. .GE. 1.) THEN 
    34733473!          print *,'last step of the day'
    34743474          DO i=1,klon
    3475                IF (masque_aqua(i)> 0) THEN
     3475               IF (masque_aqua(i).GT. 0) THEN
    34763476                   aod550_aqua(i)=aod550_aqua(i)/masque_aqua(i)
    34773477                   aod670_aqua(i)=aod670_aqua(i)/masque_aqua(i)
    … …  
    35063506                   aod865_dustsco_aqua(i)= -999.
    35073507               ENDIF
    3508                IF (masque_terra(i)> 0) THEN
     3508               IF (masque_terra(i).GT. 0) THEN
    35093509                   aod550_terra(i)=aod550_terra(i)/masque_terra(i)
    35103510                   aod670_terra(i)=aod670_terra(i)/masque_terra(i)
    … …  
    36353635      fluxss(:)=0.0
    36363636      DO i=1, klon
    3637          IF (iregion_ind(i)>0) THEN           ! LAND
     3637         IF (iregion_ind(i).GT.0) THEN           ! LAND
    36383638           ! SULFUR EMISSIONS
    36393639           fluxh2sff(i)= (lmt_so2ff_l(i)+lmt_so2ff_h(i))*frach2sofso2*  &       
    … …  
    36563656           fluxff(i)=fluxbcff(i)+fluxomff(i)
    36573657         ENDIF
    3658          IF (iregion_bb(i)>0) THEN           ! LAND
     3658         IF (iregion_bb(i).GT.0) THEN           ! LAND
    36593659           ! SULFUR EMISSIONS
    36603660           fluxso2bb(i) =scale_param_bb(iregion_bb(i)) * fracso2emis *  &
    … …  
    45154515      ENDIF
    45164516
    4517       IF (test_sca == 0 ) THEN
     4517      IF (test_sca .EQ. 0 ) THEN
    45184518        ! READ file!!
    45194519        call read_scalenc(filescaleparams,paramname_ind,            &
    … …  
    45564556
    45574557      jH_sca=jH_sca+pdtphys/(24.*3600.)
    4558       IF (jH_sca>(sca_resol)/24.) THEN
     4558      IF (jH_sca.GT.(sca_resol)/24.) THEN
    45594559          test_sca=0
    45604560          jH_sca=jH_ini
    … …  
    45684568      USE mod_grid_phy_lmdz
    45694569      USE mod_phys_lmdz_para
    4570       USE lmdz_netcdf, ONLY:nf_open,nf_close,nf_inq_varid,nf_nowrite,nf_noerr,nf90_get_var
    45714570      IMPLICIT NONE
     4571
     4572      include "netcdf.inc"
    45724573
    45734574      CHARACTER*800 filescaleparams
    … …  
    45884589          !nci=NCOPN(trim(adjustl(filescaleparams)),NCNOWRIT,rcode)
    45894590         ierr = NF_OPEN (trim(adjustl(filescaleparams)),NF_NOWRITE, nid)
    4590           if (ierr == NF_NOERR) THEN
     4591          if (ierr .EQ. NF_NOERR) THEN
    45914592          debutread=step_sca
    45924593          countread=1
    … …  
    45974598            print *,varname
    45984599            ierr = NF_INQ_VARID (nid,trim(adjustl(varname)), nvarid)
    4599             ierr = nf90_get_var (nid, nvarid, auxreal, debutread, countread)
    4600             IF (ierr /= NF_NOERR) THEN
     4600            ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debutread,          &
     4601                         countread, auxreal)
     4602            IF (ierr .NE. NF_NOERR) THEN
    46014603             PRINT*, 'Pb de lecture pour modvalues'
    46024604       print *,'JE  scale_var, step_sca',trim(adjustl(varname)),step_sca

  • LMDZ6/trunk/libf/phylmd/Dust/read_dust.F

    r5075 r5084  
    33      USE mod_grid_phy_lmdz
    44      USE mod_phys_lmdz_para
    5       USE lmdz_netcdf, ONLY:nf90_get_var
    65      IMPLICIT NONE
    76c
    87      INCLUDE "dimensions.h"
    98      INCLUDE "paramet.h"
     9      INCLUDE "netcdf.inc"
    1010c
    1111      INTEGER step, nbjour
    … …  
    4545c
    4646      start(3)=step
    47 
    48       status=nf90_get_var(ncid1,varid1,dust_nc_glo,start,count)
    49 
     47c
     48#ifdef NC_DOUBLE
     49!      status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc)
     50      status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc_glo)
     51#else
     52!      status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc)
     53      status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc_glo)
     54#endif
     55c
    5056!      call correctbid(iim,jjp1,dust_nc)
    5157      call correctbid(nbp_lon,nbp_lat,dust_nc_glo)

  • LMDZ6/trunk/libf/phylmd/Dust/read_surface.F90

    r5075 r5084  
    1010       USE mod_phys_lmdz_para
    1111       USE iophy
    12        USE lmdz_netcdf, ONLY:nf_inq_varid,nf_noerr,nf90_get_var
     12!       USE netcdf
    1313       IMPLICIT NONE
    1414
     15       INCLUDE "netcdf.inc"
    1516       INCLUDE "dimensions.h"
    1617       INCLUDE "paramet.h"
    … …  
    6465!       print *,'stat,i',status,i,outcycle,aux4s
    6566!       print *,'ifclause',status.NE. NF_NOERR ,outcycle == .false.
    66        IF ((.not.(status/= NF_NOERR) ).and.( .not. outcycle )) THEN
     67       IF ((.not.(status.NE. NF_NOERR) ).and.( .not. outcycle )) THEN
    6768         outcycle=.true.
    6869         latstr=aux4s
    … …  
    7475      varid=NCVID(ncid,latstr,rcode)
    7576
    76           status=nf90_get_var(ncid,varid,lats_glo,startj,endj)
     77#ifdef NC_DOUBLE
     78          status=NF_GET_VARA_DOUBLE(ncid,varid,startj,endj,lats_glo)
     79#else
     80          status=NF_GET_VARA_REAL(ncid,varid,startj,endj,lats_glo)
     81#endif
    7782!      print *,latstr,varid,status,jjp1,rcode
    7883!      IF (status .NE. NF_NOERR) print*,'NOOOOOOO'
    … …  
    108113! Lecture
    109114! -----------------------
    110           status=nf90_get_var(ncid,varid,tmp_dyn_glo,start,count)
     115#ifdef NC_DOUBLE
     116          status=NF_GET_VARA_DOUBLE(ncid,varid,start,count,tmp_dyn_glo)
     117#else
     118          status=NF_GET_VARA_REAL(ncid,varid,start,count,tmp_dyn_glo)
     119#endif
    111120
    112121!      call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn   ')

  • LMDZ6/trunk/libf/phylmd/Dust/read_vent.F

    r5075 r5084  
    33      USE mod_grid_phy_lmdz
    44      USE mod_phys_lmdz_para
    5       USE lmdz_netcdf, ONLY: nf90_get_var
    65!      USE write_field_phy
    76      IMPLICIT NONE
    … …  
    98c       INCLUDE "dimphy.h"
    109      INCLUDE "paramet.h"
     10      INCLUDE "netcdf.inc"
    1111c
    1212      INTEGER step, nbjour
    … …  
    5151c
    5252      start(3)=step
    53 
    54       status=nf90_get_var(ncidu1,varidu1,u10m_nc_glo,start,count)
    55 
    56       status=nf90_get_var(ncidv1,varidv1,v10m_nc_glo,start,count)
    57 
     53c
     54#ifdef NC_DOUBLE
     55!      status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc)
     56      status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc_glo)
     57#else
     58!      status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc)
     59      status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc_glo)
     60#endif
     61!       print *,status
     62c
     63#ifdef NC_DOUBLE
     64!      status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc)
     65      status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc_glo)
     66#else
     67!      status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc)
     68      status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc_glo)
     69#endif
     70c
    5871
    5972!      print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1)
    … …  
    118131      do l=1,nl
    119132         do i=2,iim-1
    120             if(abs(x(i,l))>1.e10) then
     133            if(abs(x(i,l)).gt.1.e10) then
    121134               zz=0.5*(x(i-1,l)+x(i+1,l))
    122135c              print*,'correction ',i,l,x(i,l),zz

  • LMDZ6/trunk/libf/phylmd/StratAer/interp_sulf_input.F90

    r5075 r5084  
    66  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                      nf95_inq_varid, nf95_inquire_dimension, nf95_open
    8   USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     8  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010  USE mod_grid_phy_lmdz

  • LMDZ6/trunk/libf/phylmd/StratAer/stratH2O_methox.F90

    r5075 r5084  
    88  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    99                      nf95_inq_varid, nf95_inquire_dimension, nf95_open
    10   USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     10  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    1111
    1212  USE mod_grid_phy_lmdz
    … …  
    7979!
    8080 
    81   IF (debutphy .OR. mth_cur /= mth_pre) THEN
     81  IF (debutphy .OR. mth_cur .NE. mth_pre) THEN
    8282     
    8383!--preparation of global fields

  • LMDZ6/trunk/libf/phylmd/condsurf.F90

    r5075 r5084  
    77  USE indice_sol_mod
    88  USE time_phylmdz_mod, ONLY: annee_ref
    9   USE lmdz_netcdf, ONLY: nf90_get_var,nf_open,nf_inq_varid,nf_noerr,nf_close,nf_nowrite
    109  IMPLICIT NONE
    1110
    … …  
    2120  ! lmt_bils: bilan chaleur au sol (a utiliser pour "slab-ocean")
    2221
     22  include "netcdf.inc"
    2323  INTEGER nid, nvarid
    2424  INTEGER debut(2)
    … …  
    110110    END IF
    111111    PRINT *, 'debut,epais', debut, epais, 'jour,jourvrai', jour, jourvrai
    112     ierr = nf90_get_var(nid, nvarid,  lmt_bils_glo, debut, epais)
     112#ifdef NC_DOUBLE
     113    ierr = nf_get_vara_double(nid, nvarid, debut, epais, lmt_bils_glo)
     114#else
     115    ierr = nf_get_vara_real(nid, nvarid, debut, epais, lmt_bils_glo)
     116#endif
    113117    IF (ierr/=nf_noerr) THEN
    114118      CALL abort_physic('condsurf', 'Lecture echouee pour <BILS>', 1)

  • LMDZ6/trunk/libf/phylmd/create_etat0_unstruct_mod.F90

    r5075 r5084  
    2323  SUBROUTINE init_create_etat0_unstruct
    2424  USE lmdz_xios
    25   USE lmdz_netcdf, ONLY: NF90_NOWRITE,nf90_close,nf90_noerr,nf90_open
     25  USE netcdf
    2626  USE mod_phys_lmdz_para
    2727  IMPLICIT NONE
    … …  
    126126      CALL xios_recv_field("qs",qsol_mpi)
    127127      CALL xios_recv_field("mask",zmasq_mpi)
    128       IF (landice_opt < 2) CALL xios_recv_field("landice",lic_mpi)
     128      IF (landice_opt .LT. 2) CALL xios_recv_field("landice",lic_mpi)
    129129    ENDIF
    130130    CALL scatter_omp(tsol_mpi,tsol)
    131131    CALL scatter_omp(qsol_mpi,qsol)
    132132    CALL scatter_omp(zmasq_mpi,zmasq)
    133     IF (landice_opt < 2) CALL scatter_omp(lic_mpi,lic)
     133    IF (landice_opt .LT. 2) CALL scatter_omp(lic_mpi,lic)
    134134
    135135    radsol(:)   = 0.0
    … …  
    143143
    144144    pctsrf(:,:) = 0
    145     IF (landice_opt < 2) THEN
     145    IF (landice_opt .LT. 2) THEN
    146146       pctsrf(:,is_lic)=lic
    147147       WHERE(pctsrf(:,is_lic)<EPSFRA) pctsrf(:,is_lic)=0.
    … …  
    180180  !--- The ocean and sea-ice fractions are not changed.
    181181  !--- This option is only available if landice_opt<2.   
    182   IF (landice_opt < 2) THEN
     182  IF (landice_opt .LT. 2) THEN
    183183     no_ter_antartique=.FALSE.
    184184     CALL getin_p('no_ter_antartique',no_ter_antartique)

  • 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 ?)

  • LMDZ6/trunk/libf/phylmd/grid_noro_m.F90

    r5075 r5084  
    435435! Purpose: Read parameters usually determined with grid_noro from a file.
    436436!===============================================================================
    437   USE lmdz_netcdf, ONLY: NF90_OPEN,  NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION,        &
     437  USE netcdf, ONLY: NF90_OPEN,  NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION,        &
    438438        NF90_NOERR, NF90_CLOSE, NF90_INQ_VARID, NF90_GET_VAR, NF90_STRERROR,   &
    439439        NF90_NOWRITE

  • LMDZ6/trunk/libf/phylmd/ice_sursat_mod.F90

    r5075 r5084  
    9696  USE mod_phys_lmdz_para, ONLY: scatter, bcast
    9797  USE print_control_mod, ONLY: lunout
    98   USE lmdz_netcdf, ONLY: nf90_get_var, nf_inq_varid, nf_inq_dimlen, nf_inq_dimid, &
    99       nf_open, nf_noerr
    10098
    10199  IMPLICIT NONE
    102100
    103101  INCLUDE "YOMCST.h"
     102  INCLUDE 'netcdf.inc'
    104103
    105104  !--------------------------------------------------------
    … …  
    169168      iret = nf_inq_varid(ncida, 'lev', varid)
    170169      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get lev dimid aircraft_phy.nc file',1)
    171       iret = nf90_get_var(ncida, varid, zmida)
     170      iret = nf_get_var_double(ncida, varid, zmida)
    172171      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read zmida file',1)
    173172      !
    174173      iret = nf_inq_varid(ncida, 'emi_co2_aircraft', varid)  !--CO2 as a proxy for m flown -
    175174      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_distance dimid aircraft_phy.nc file',1)
    176       iret = nf90_get_var(ncida, varid, pkm_airpl_glo)
     175      iret = nf_get_var_double(ncida, varid, pkm_airpl_glo)
    177176      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read pkm_airpl file',1)
    178177      !
    179178      iret = nf_inq_varid(ncida, 'emi_h2o_aircraft', varid)
    180179      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to get emi_h2o_aircraft dimid aircraft_phy.nc file',1)
    181       iret = nf90_get_var(ncida, varid, ph2o_airpl_glo)
     180      iret = nf_get_var_double(ncida, varid, ph2o_airpl_glo)
    182181      IF (iret /= NF_NOERR) CALL abort_physic(modname,'problem to read ph2o_airpl file',1)
    183182      !
    … …  
    277276  !
    278277  DO i=1, klon
    279    IF (latitude_deg(i)>=42.0.AND.latitude_deg(i)<=48.0) THEN
     278   IF (latitude_deg(i).GE.42.0.AND.latitude_deg(i).LE.48.0) THEN
    280279     flight_m(i,38) = 50000.0  !--5000 m of flight/second in grid cell x 10 scaling
    281280   ENDIF
    … …  
    413412     pdf_b = pdf_k/(2.*sqrt(2.))
    414413     pdf_e1 = pdf_a+pdf_b
    415      IF (abs(pdf_e1)>=erf_lim) THEN
     414     IF (abs(pdf_e1).GE.erf_lim) THEN
    416415        pdf_e1 = sign(1.,pdf_e1)
    417416        pdf_N = max(0.,sign(rneb,pdf_e1))
    … …  
    426425     ! On perd la memoire sur la temperature (sur qvc) pour garder
    427426     ! celle sur alpha_cld
    428      IF (pdf_N>1.) THEN
     427     IF (pdf_N.GT.1.) THEN
    429428        ! On inverse alpha_cld = int_qvc^infty P(q) dq
    430429        ! pour determiner qvc = f(alpha_cld)
    … …  
    442441        pdf_a = log(qvc/q)/(pdf_k*sqrt(2.))
    443442        pdf_e1 = pdf_a+pdf_b
    444         IF (abs(pdf_e1)>=erf_lim) THEN
     443        IF (abs(pdf_e1).GE.erf_lim) THEN
    445444           pdf_e1 = sign(1.,pdf_e1)
    446445        ELSE
    … …  
    462461        pdf_a = log(qvc*gamma_prec/q)/(pdf_k*sqrt(2.))
    463462        pdf_e2 = pdf_a+pdf_b
    464         IF (abs(pdf_e2)>=erf_lim) THEN
     463        IF (abs(pdf_e2).GE.erf_lim) THEN
    465464           pdf_e2 = sign(1.,pdf_e2)
    466465        ELSE
    … …  
    469468        pdf_e2 = 0.5*(1.+pdf_e2) ! integrale sous P pour q > gamma qsat
    470469
    471         IF (abs(pdf_e1-pdf_e2)<eps) THEN
     470        IF (abs(pdf_e1-pdf_e2).LT.eps) THEN
    472471           pdf_N1 = pdf_N2
    473472        ELSE
    … …  
    476475
    477476        ! Barriere qui traite le cas gamma_prec = 1.
    478         IF (pdf_N1<=0.) THEN
     477        IF (pdf_N1.LE.0.) THEN
    479478           pdf_N1 = 0.
    480            IF (pdf_e2>eps) THEN
     479           IF (pdf_e2.GT.eps) THEN
    481480              pdf_N2 = rneb/pdf_e2
    482481           ELSE
    … …  
    488487     ! Physique 1
    489488     ! Sublimation
    490      IF (qvc<qsat) THEN
     489     IF (qvc.LT.qsat) THEN
    491490        pdf_a = log(qvc/q)/(pdf_k*sqrt(2.))
    492491        pdf_e1 = pdf_a+pdf_b
    493         IF (abs(pdf_e1)>=erf_lim) THEN
     492        IF (abs(pdf_e1).GE.erf_lim) THEN
    494493           pdf_e1 = sign(1.,pdf_e1)
    495494        ELSE
    … …  
    499498        pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
    500499        pdf_e2 = pdf_a+pdf_b
    501         IF (abs(pdf_e2)>=erf_lim) THEN
     500        IF (abs(pdf_e2).GE.erf_lim) THEN
    502501           pdf_e2 = sign(1.,pdf_e2)
    503502        ELSE
    … …  
    517516
    518517     ! Condensation
    519      IF (gamma_ss*qsat<gamma_prec*qvc) THEN
     518     IF (gamma_ss*qsat.LT.gamma_prec*qvc) THEN
    520519     
    521520        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
    522521        pdf_e1 = pdf_a+pdf_b
    523         IF (abs(pdf_e1)>=erf_lim) THEN
     522        IF (abs(pdf_e1).GE.erf_lim) THEN
    524523           pdf_e1 = sign(1.,pdf_e1)
    525524        ELSE
    … …  
    529528        pdf_a = log(gamma_prec*qvc/q)/(pdf_k*sqrt(2.))
    530529        pdf_e2 = pdf_a+pdf_b
    531         IF (abs(pdf_e2)>=erf_lim) THEN
     530        IF (abs(pdf_e2).GE.erf_lim) THEN
    532531           pdf_e2 = sign(1.,pdf_e2)
    533532        ELSE
    … …  
    546545        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
    547546        pdf_e1 = pdf_a+pdf_b
    548         IF (abs(pdf_e1)>=erf_lim) THEN
     547        IF (abs(pdf_e1).GE.erf_lim) THEN
    549548           pdf_e1 = sign(1.,pdf_e1)
    550549        ELSE
    … …  
    563562     pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
    564563     pdf_e1 = pdf_a+pdf_b
    565      IF (abs(pdf_e1)>=erf_lim) THEN
     564     IF (abs(pdf_e1).GE.erf_lim) THEN
    566565        pdf_e1 = sign(1.,pdf_e1)
    567566     ELSE
    … …  
    571570
    572571     pdf_e2 = pdf_a-pdf_b
    573      IF (abs(pdf_e2)>=erf_lim) THEN
     572     IF (abs(pdf_e2).GE.erf_lim) THEN
    574573        pdf_e2 = sign(1.,pdf_e2)
    575574     ELSE
    … …  
    585584     pdf_a = log(max(qsat,qvc)/q)/(pdf_k*sqrt(2.))
    586585     pdf_e1 = pdf_a-pdf_b
    587      IF (abs(pdf_e1)>=erf_lim) THEN
     586     IF (abs(pdf_e1).GE.erf_lim) THEN
    588587        pdf_e1 = sign(1.,pdf_e1)
    589588     ELSE
    … …  
    593592     pdf_a = log(min(gamma_ss*qsat,gamma_prec*qvc)/q)/(pdf_k*sqrt(2.))
    594593     pdf_e2 = pdf_a-pdf_b
    595      IF (abs(pdf_e2)>=erf_lim) THEN
     594     IF (abs(pdf_e2).GE.erf_lim) THEN
    596595        pdf_e2 = sign(1.,pdf_e2)
    597596     ELSE
    … …  
    604603
    605604     ! Partie 2 (sous condition)
    606      IF (gamma_ss*qsat>gamma_prec*qvc) THEN
     605     IF (gamma_ss*qsat.GT.gamma_prec*qvc) THEN
    607606        pdf_a = log(gamma_ss*qsat/q)/(pdf_k*sqrt(2.))
    608607        pdf_e1 = pdf_a-pdf_b
    609         IF (abs(pdf_e1)>=erf_lim) THEN
     608        IF (abs(pdf_e1).GE.erf_lim) THEN
    610609           pdf_e1 = sign(1.,pdf_e1)
    611610        ELSE
    … …  
    633632
    634633     ! Physique 2 : Turbulence
    635      IF (rneb>eps.AND.rneb<1.-eps) THEN ! rneb != 0 and != 1
     634     IF (rneb.GT.eps.AND.rneb.LT.1.-eps) THEN ! rneb != 0 and != 1
    636635       !
    637636       tke = pbl_tke(i,k,is_ave)
    … …  
    643642       b_tur = (rneb*V_cell/4./PI/N_cld)**(1./3.)
    644643       ! On verifie que la longeur de melange n'est pas trop grande
    645        IF (L_tur>b_tur) THEN
     644       IF (L_tur.GT.b_tur) THEN
    646645          L_tur = b_tur
    647646       ENDIF
    … …  
    666665       q_eq = q_eq/(V_env + V_cld)
    667666
    668        IF (q_eq>qsat) THEN
     667       IF (q_eq.GT.qsat) THEN
    669668          drnebclr = - V_clr/V_cell
    670669          dqclr = drnebclr*qclr/MAX(eps,rnebclr)
    … …  
    704703     ! Barrieres
    705704     ! ISSR trop petite
    706      IF (rnebss<eps) THEN
     705     IF (rnebss.LT.eps) THEN
    707706        rneb = MIN(rneb + rnebss,1.0-eps) !--ajout OB barriere
    708707        qcld = qcld + qss
    … …  
    712711
    713712     ! le nuage est trop petit
    714      IF (rneb<eps) THEN
     713     IF (rneb.LT.eps) THEN
    715714        ! s'il y a une ISSR on met tout dans l'ISSR, sinon dans le
    716715        ! clear sky
    717         IF (rnebss<eps) THEN
     716        IF (rnebss.LT.eps) THEN
    718717           rnebclr = 1.
    719718           rnebss = 0. !--ajout OB
    … …  
    750749     !--critical T_LM below which no liquid contrail can form in exhaust
    751750     !Tcontr(i,k) = 226.69+9.43*log(Gcontr-0.053)+0.72*(log(Gcontr-0.053))**2 !--K
    752      IF (Gcontr > 0.1) THEN
     751     IF (Gcontr .GT. 0.1) THEN
    753752     !
    754753       Tcontr = 226.69+9.43*log(Gcontr-0.053)+0.72*(log(Gcontr-0.053))**2 !--K
    … …  
    776775       !qcontr2 = eps_w*qcontr / (pplay+eps_w*qcontr)
    777776       !
    778        IF (t < Tcontr) THEN !--contrail formation is possible
     777       IF (t .LT. Tcontr) THEN !--contrail formation is possible
    779778       !
    780779       !--compute fractions of persistent (P) and non-persistent(N) contrail potential regions
    781780       !!IF (qcontr(i,k).GE.qsat) THEN
    782        IF (qcontr2>=qsat) THEN
     781       IF (qcontr2.GE.qsat) THEN
    783782         !--none of the unsaturated clear sky is prone for contrail formation
    784783         !!fcontrN(i,k) = 0.0
    … …  
    788787         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
    789788         pdf_e1 = pdf_a+pdf_b
    790          IF (abs(pdf_e1)>=erf_lim) THEN
     789         IF (abs(pdf_e1).GE.erf_lim) THEN
    791790            pdf_e1 = sign(1.,pdf_e1)
    792791         ELSE
    … …  
    797796         pdf_a = log(MIN(qcontr2,qvc)/q)/(pdf_k*sqrt(2.))
    798797         pdf_e2 = pdf_a+pdf_b
    799          IF (abs(pdf_e2)>=erf_lim) THEN
     798         IF (abs(pdf_e2).GE.erf_lim) THEN
    800799            pdf_e2 = sign(1.,pdf_e2)
    801800         ELSE
    … …  
    808807         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
    809808         pdf_e1 = pdf_a+pdf_b
    810          IF (abs(pdf_e1)>=erf_lim) THEN
     809         IF (abs(pdf_e1).GE.erf_lim) THEN
    811810            pdf_e1 = sign(1.,pdf_e1)
    812811         ELSE
    … …  
    817816         pdf_a = log(MIN(qcontr2,qvc)/q)/(pdf_k*sqrt(2.))
    818817         pdf_e2 = pdf_a+pdf_b
    819          IF (abs(pdf_e2)>=erf_lim) THEN
     818         IF (abs(pdf_e2).GE.erf_lim) THEN
    820819            pdf_e2 = sign(1.,pdf_e2)
    821820         ELSE
    … …  
    828827         pdf_a = log(MAX(qsat,qvc)/q)/(pdf_k*sqrt(2.))
    829828         pdf_e1 = pdf_a+pdf_b
    830          IF (abs(pdf_e1)>=erf_lim) THEN
     829         IF (abs(pdf_e1).GE.erf_lim) THEN
    831830            pdf_e1 = sign(1.,pdf_e1)
    832831         ELSE
    … …  
    837836         pdf_a = log(MIN(qcontr2,MIN(gamma_prec*qvc,gamma_ss*qsat))/q)/(pdf_k*sqrt(2.))
    838837         pdf_e2 = pdf_a+pdf_b
    839          IF (abs(pdf_e2)>=erf_lim) THEN
     838         IF (abs(pdf_e2).GE.erf_lim) THEN
    840839            pdf_e2 = sign(1.,pdf_e2)
    841840         ELSE
    … …  
    848847         pdf_a = log(gamma_prec*qvc/q)/(pdf_k*sqrt(2.))
    849848         pdf_e1 = pdf_a+pdf_b
    850          IF (abs(pdf_e1)>=erf_lim) THEN
     849         IF (abs(pdf_e1).GE.erf_lim) THEN
    851850            pdf_e1 = sign(1.,pdf_e1)
    852851         ELSE
    … …  
    857856         pdf_a = log(MIN(qcontr2,gamma_ss*qsat)/q)/(pdf_k*sqrt(2.))
    858857         pdf_e2 = pdf_a+pdf_b
    859          IF (abs(pdf_e2)>=erf_lim) THEN
     858         IF (abs(pdf_e2).GE.erf_lim) THEN
    860859            pdf_e2 = sign(1.,pdf_e2)
    861860         ELSE
    … …  
    876875         pdf_a = log(qcontr2/q)/(pdf_k*sqrt(2.))
    877876         pdf_e1 = pdf_a+pdf_b   !--normalement pdf_b est deja defini
    878          IF (abs(pdf_e1)>=erf_lim) THEN
     877         IF (abs(pdf_e1).GE.erf_lim) THEN
    879878            pdf_e1 = sign(1.,pdf_e1)
    880879         ELSE
    … …  
    884883         pdf_a = log(qsat/q)/(pdf_k*sqrt(2.))
    885884         pdf_e2 = pdf_a+pdf_b
    886          IF (abs(pdf_e2)>=erf_lim) THEN
     885         IF (abs(pdf_e2).GE.erf_lim) THEN
    887886            pdf_e2 = sign(1.,pdf_e2)
    888887         ELSE

  • LMDZ6/trunk/libf/phylmd/inlandsis/surf_inlandsis_mod.F90

    r5075 r5084  
    638638            END DO
    639639
    640             IF (sissnow(ikl) <= sn_low) THEN  !add snow
    641                 IF (isnoSV(ikl)>=1) THEN
     640            IF (sissnow(ikl) .LE. sn_low) THEN  !add snow
     641                IF (isnoSV(ikl).GE.1) THEN
    642642                    dzsnSV(ikl, 1) = dzsnSV(ikl, 1) + sn_add / max(ro__SV(ikl, 1), epsi)
    643643                    toicSV(ikl) = toicSV(ikl) - sn_add
    … …  
    657657            END IF
    658658
    659             IF (sissnow(ikl) >= sn_upp) THEN  !thinnen snow layer below
     659            IF (sissnow(ikl) .ge. sn_upp) THEN  !thinnen snow layer below
    660660                dzsnSV(ikl, 1) = dzsnSV(ikl, 1) / sn_div
    661661                toicSV(ikl) = toicSV(ikl) + dzsnSV(ikl, 1) * ro__SV(ikl, 1) / sn_div
    … …  
    10491049        ! Objet: Lecture du fichier de conditions initiales pour SISVAT
    10501050        !======================================================================
     1051        include "netcdf.inc"
    10511052        !    include "indicesol.h"
    10521053
    … …  
    11171118
    11181119        DO isn = 1, nsno
    1119             IF (isn<=99) THEN
     1120            IF (isn.LE.99) THEN
    11201121                WRITE(str2, '(i2.2)') isn
    11211122                CALL get_field("AGESNOW" // str2, &
    … …  
    11271128        ENDDO
    11281129        DO isn = 1, nsno
    1129             IF (isn<=99) THEN
     1130            IF (isn.LE.99) THEN
    11301131                WRITE(str2, '(i2.2)') isn
    11311132                CALL get_field("DZSNOW" // str2, &
    … …  
    11371138        ENDDO
    11381139        DO isn = 1, nsno
    1139             IF (isn<=99) THEN
     1140            IF (isn.LE.99) THEN
    11401141                WRITE(str2, '(i2.2)') isn
    11411142                CALL get_field("G2SNOW" // str2, &
    … …  
    11471148        ENDDO
    11481149        DO isn = 1, nsno
    1149             IF (isn<=99) THEN
     1150            IF (isn.LE.99) THEN
    11501151                WRITE(str2, '(i2.2)') isn
    11511152                CALL get_field("G1SNOW" // str2, &
    … …  
    11571158        ENDDO
    11581159        DO isn = 1, nsismx
    1159             IF (isn<=99) THEN
     1160            IF (isn.LE.99) THEN
    11601161                WRITE(str2, '(i2.2)') isn
    11611162                CALL get_field("ETA" // str2, &
    … …  
    11671168        ENDDO
    11681169        DO isn = 1, nsismx
    1169             IF (isn<=99) THEN
     1170            IF (isn.LE.99) THEN
    11701171                WRITE(str2, '(i2.2)') isn
    11711172                CALL get_field("RO" // str2, &
    … …  
    11771178        ENDDO
    11781179        DO isn = 1, nsismx
    1179             IF (isn<=99) THEN
     1180            IF (isn.LE.99) THEN
    11801181                WRITE(str2, '(i2.2)') isn
    11811182                CALL get_field("TSS" // str2, &
    … …  
    11871188        ENDDO
    11881189        DO isn = 1, nsno
    1189             IF (isn<=99) THEN
     1190            IF (isn.LE.99) THEN
    11901191                WRITE(str2, '(i2.2)') isn
    11911192                CALL get_field("HISTORY" // str2, &
    … …  
    12861287        IMPLICIT none
    12871288
     1289        include "netcdf.inc"
    12881290        !    include "indicesol.h"
    12891291        !    include "dimsoil.h"
    … …  
    14011403
    14021404            DO isn = 1, nsno
    1403                 IF (isn<=99) THEN
     1405                IF (isn.LE.99) THEN
    14041406                    WRITE(str2, '(i2.2)') isn
    14051407                    CALL put_field(pass, "AGESNOW" // str2, &
    … …  
    14121414            ENDDO
    14131415            DO isn = 1, nsno
    1414                 IF (isn<=99) THEN
     1416                IF (isn.LE.99) THEN
    14151417                    WRITE(str2, '(i2.2)') isn
    14161418                    CALL put_field(pass, "DZSNOW" // str2, &
    … …  
    14231425            ENDDO
    14241426            DO isn = 1, nsno
    1425                 IF (isn<=99) THEN
     1427                IF (isn.LE.99) THEN
    14261428                    WRITE(str2, '(i2.2)') isn
    14271429                    CALL put_field(pass, "G2SNOW" // str2, &
    … …  
    14341436            ENDDO
    14351437            DO isn = 1, nsno
    1436                 IF (isn<=99) THEN
     1438                IF (isn.LE.99) THEN
    14371439                    WRITE(str2, '(i2.2)') isn
    14381440                    CALL put_field(pass, "G1SNOW" // str2, &
    … …  
    14451447            ENDDO
    14461448            DO isn = 1, nsismx
    1447                 IF (isn<=99) THEN
     1449                IF (isn.LE.99) THEN
    14481450                    WRITE(str2, '(i2.2)') isn
    14491451                    CALL put_field(pass, "ETA" // str2, &
    … …  
    14561458            ENDDO
    14571459            DO isn = 1, nsismx   !nsno
    1458                 IF (isn<=99) THEN
     1460                IF (isn.LE.99) THEN
    14591461                    WRITE(str2, '(i2.2)') isn
    14601462                    CALL put_field(pass, "RO" // str2, &
    … …  
    14671469            ENDDO
    14681470            DO isn = 1, nsismx
    1469                 IF (isn<=99) THEN
     1471                IF (isn.LE.99) THEN
    14701472                    WRITE(str2, '(i2.2)') isn
    14711473                    CALL put_field(pass, "TSS" // str2, &
    … …  
    14781480            ENDDO
    14791481            DO isn = 1, nsno
    1480                 IF (isn<=99) THEN
     1482                IF (isn.LE.99) THEN
    14811483                    WRITE(str2, '(i2.2)') isn
    14821484                    CALL put_field(pass, "HISTORY" // str2, &

  • LMDZ6/trunk/libf/phylmd/interfoce_lim.F90

    r5075 r5084  
    1010  USE mod_phys_lmdz_para
    1111  USE indice_sol_mod
    12   USE lmdz_netcdf, ONLY: nf90_get_var,nf_close,nf_noerr,nf_inq_varid,nf_open,nf_nowrite
    1312 
    1413  IMPLICIT NONE
     14 
     15  INCLUDE "netcdf.inc"
    1516
    1617! Cette routine sert d'interface entre le modele atmospherique et un fichier
    … …  
    115116        fich = TRIM(fich)
    116117        ierr = NF_OPEN (fich, NF_NOWRITE,nid)
    117         IF (ierr/=NF_NOERR) THEN
     118        IF (ierr.NE.NF_NOERR) THEN
    118119           abort_message = 'Pb d''ouverture du fichier de conditions aux limites'
    119120           CALL abort_physic(modname,abort_message,1)
    … …  
    136137              CALL abort_physic(modname,abort_message,1)
    137138           ENDIF
    138            ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_oce),start,epais)
     139#ifdef NC_DOUBLE
     140           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_oce))
     141#else
     142           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_oce))
     143#endif
    139144           IF (ierr /= NF_NOERR) THEN
    140145              abort_message = 'Lecture echouee pour <FOCE>'
    … …  
    149154              CALL abort_physic(modname,abort_message,1)
    150155           ENDIF
    151            ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_sic),start,epais)
     156#ifdef NC_DOUBLE
     157           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_sic))
     158#else
     159           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_sic))
     160#endif
    152161           IF (ierr /= NF_NOERR) THEN
    153162              abort_message = 'Lecture echouee pour <FSIC>'
    … …  
    162171              CALL abort_physic(modname,abort_message,1)
    163172           ENDIF
    164            ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_ter),start,epais)
     173#ifdef NC_DOUBLE
     174           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_ter))
     175#else
     176           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_ter))
     177#endif
    165178           IF (ierr /= NF_NOERR) THEN
    166179              abort_message = 'Lecture echouee pour <FTER>'
    … …  
    175188              CALL abort_physic(modname,abort_message,1)
    176189           ENDIF
    177            ierr = nf90_get_var(nid,nvarid,pct_tmp(:,is_lic),start,epais)
     190#ifdef NC_DOUBLE
     191           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais,pct_tmp(1,is_lic))
     192#else
     193           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais,pct_tmp(1,is_lic))
     194#endif
    178195           IF (ierr /= NF_NOERR) THEN
    179196              abort_message = 'Lecture echouee pour <FLIC>'
    … …  
    188205              CALL abort_physic(modname,abort_message,1)
    189206           ENDIF
    190            ierr = nf90_get_var(nid,nvarid,nat_lu,start,epais)
     207#ifdef NC_DOUBLE
     208           ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, nat_lu)
     209#else
     210           ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, nat_lu)
     211#endif
    191212           IF (ierr /= NF_NOERR) THEN
    192213              abort_message = 'Lecture echouee pour <NAT>'
    … …  
    218239           CALL abort_physic(modname,abort_message,1)
    219240        ENDIF
    220         ierr = nf90_get_var(nid,nvarid,sst_lu,start,epais)
     241#ifdef NC_DOUBLE
     242        ierr = NF_GET_VARA_DOUBLE(nid,nvarid,start,epais, sst_lu)
     243#else
     244        ierr = NF_GET_VARA_REAL(nid,nvarid,start,epais, sst_lu)
     245#endif
    221246        IF (ierr /= NF_NOERR) THEN
    222247           abort_message = 'Lecture echouee pour <SST>'

  • LMDZ6/trunk/libf/phylmd/iostart.F90

    r5075 r5084  
    11MODULE iostart
    2  
     2
    33PRIVATE
    44    INTEGER,SAVE :: nid_start
    … …  
    3030
    3131  SUBROUTINE Open_startphy(filename)
    32   USE lmdz_netcdf, ONLY: nf90_nowrite, nf90_noerr,nf90_open
     32  USE netcdf
    3333  USE mod_phys_lmdz_para
    3434  IMPLICIT NONE
    … …  
    3838    IF (is_mpi_root .AND. is_omp_root) THEN
    3939      ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)
    40       IF (ierr/=NF90_NOERR) THEN
     40      IF (ierr.NE.NF90_NOERR) THEN
    4141        write(6,*)' Pb d''ouverture du fichier '//filename
    4242        write(6,*)' ierr = ', ierr
    … …  
    4848
    4949  SUBROUTINE Close_startphy
    50   USE lmdz_netcdf, ONLY: nf90_close
     50  USE netcdf
    5151  USE mod_phys_lmdz_para
    5252  IMPLICIT NONE
    … …  
    6161
    6262  FUNCTION Inquire_Field(Field_name)
    63   USE lmdz_netcdf, ONLY: nf90_noerr,nf90_inq_varid
     63  USE netcdf
    6464  USE mod_phys_lmdz_para
    6565  IMPLICIT NONE
    … …  
    115115 
    116116  SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
    117   USE lmdz_netcdf, ONLY: nf90_inq_varid,nf90_noerr,nf90_get_var
     117  USE netcdf
    118118  USE dimphy
    119119  USE geometry_mod
    … …  
    251251
    252252  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
    253   USE lmdz_netcdf, ONLY: nf90_noerr,nf90_get_var,nf90_inq_varid
     253  USE netcdf
    254254  USE dimphy
    255255  USE mod_grid_phy_lmdz
    … …  
    301301
    302302  SUBROUTINE open_restartphy(filename)
    303   USE lmdz_netcdf, ONLY: nf90_create,nf90_clobber,nf90_64bit_offset,nf90_noerr,nf90_strerror,&
    304           nf90_global,nf90_put_att,nf90_def_dim
     303  USE netcdf
    305304  USE mod_phys_lmdz_para, ONLY: is_master
    306305  USE mod_grid_phy_lmdz, ONLY: klon_glo
    … …  
    333332 
    334333  SUBROUTINE enddef_restartphy
    335   USE lmdz_netcdf, ONLY: nf90_enddef
     334  USE netcdf
    336335  USE mod_phys_lmdz_para
    337336  IMPLICIT NONE
    … …  
    343342
    344343  SUBROUTINE close_restartphy
    345   USE lmdz_netcdf, ONLY: nf90_close
     344  USE netcdf
    346345  USE mod_phys_lmdz_para
    347346  IMPLICIT NONE
    … …  
    386385 
    387386  SUBROUTINE put_field_rgen(pass, field_name,title,field,field_size)
    388   USE lmdz_netcdf, ONLY: nf90_def_var,nf90_format,nf90_put_att,nf90_inq_varid,nf90_put_var
     387  USE netcdf
    389388  USE dimphy
    390389  USE geometry_mod
    … …  
    425424         
    426425!      ierr = NF90_REDEF (nid_restart)
    427       ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FORMAT,(/ idim /),nvarid)
     426#ifdef NC_DOUBLE
     427      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
     428#else
     429      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
     430#endif
    428431      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
    429432!      ierr = NF90_ENDDEF(nid_restart)
    … …  
    509512
    510513  SUBROUTINE put_var_rgen(pass, var_name,title,var,var_size)
    511   USE lmdz_netcdf, ONLY: nf90_format,nf90_def_var,nf90_put_var,nf90_inq_varid,nf90_put_att
     514  USE netcdf
    512515  USE dimphy
    513516  USE mod_phys_lmdz_para
    … …  
    534537!      ierr = NF90_REDEF (nid_restart)
    535538
    536         ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FORMAT,(/ idim1 /),nvarid)
     539#ifdef NC_DOUBLE
     540        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
     541#else
     542        ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
     543#endif
    537544        IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
    538545!      ierr = NF90_ENDDEF(nid_restart)

  • LMDZ6/trunk/libf/phylmd/iotd_ecrit.F90

    r5075 r5084  
    2222!=================================================================
    2323 
    24       USE lmdz_netcdf, ONLY: nf90_put_var,nf_inq_varid,nf_enddef,nf_redef,nf_sync,nf_noerr,&
    25               nf_float,nf_def_var
     24      use netcdf, only: nf90_put_var
    2625      implicit none
    2726
    2827! Commons
    2928
     29      INCLUDE "netcdf.inc"
    3030      INCLUDE "iotd.h"
    3131
    … …  
    9090
    9191!! Quand on tombe sur la premiere variable on ajoute un pas de temps
    92         if (nom==firstnom) then
     92        if (nom.eq.firstnom) then
    9393        ! We have identified a "first call" (at given date)
    9494
    … …  
    114114!        print*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date
    115115
    116            if (ierr/=NF_NOERR) then
     116           if (ierr.ne.NF_NOERR) then
    117117              write(*,*) "***** PUT_VAR matter in writediagfi_nc"
    118118              write(*,*) "***** with time"
    … …  
    175175      ierr= NF90_PUT_VAR(nid,varid,zx,corner,edges)
    176176
    177       if (ierr/=NF_NOERR) then
     177      if (ierr.ne.NF_NOERR) then
    178178           write(*,*) "***** PUT_VAR problem in writediagfi"
    179179           write(*,*) "***** with ",nom

  • LMDZ6/trunk/libf/phylmd/iotd_fin.F90

    r5075 r5084  
    1 SUBROUTINE iotd_fin
    2   USE lmdz_netcdf, ONLY : nf_close
     1      SUBROUTINE iotd_fin
     2      IMPLICIT NONE
    33
    4   IMPLICIT NONE
     4!=======================================================================
     5!
     6!   Auteur:  F. Hourdin
     7!   -------
     8!
     9!   Objet:
     10!   ------
     11!   Light interface for netcdf outputs. can be used outside LMDZ
     12!
     13!=======================================================================
    514
    6   !=======================================================================
    7   !
    8   !   Auteur:  F. Hourdin
    9   !   -------
    10   !
    11   !   Objet:
    12   !   ------
    13   !   Light interface for netcdf outputs. can be used outside LMDZ
    14   !
    15   !=======================================================================
    1615
    17   INCLUDE "iotd.h"
    18   integer ierr
     16      INCLUDE "netcdf.inc"
     17      INCLUDE "iotd.h"
     18      integer ierr
    1919
    20   !   Arguments:
    21   !   ----------
     20!   Arguments:
     21!   ----------
    2222
    23   ierr = NF_close(nid)
     23      ierr=NF_close(nid)
    2424
    25 END
     25      END

  • LMDZ6/trunk/libf/phylmd/iotd_ini.F90

    r5075 r5084  
    11      SUBROUTINE iotd_ini(fichnom,iim,jjm,llm,prlon,prlat,pcoordv,jour0,mois0,an0,t0,timestep,calendrier)
    2             USE lmdz_netcdf, ONLY: nf_enddef,nf_put_att_text,nf_float,nf_def_var,nf_redef,&
    3                     nf_global,nf_def_dim,nf_create,nf_clobber,nf_unlimited,nf90_put_var
    42      IMPLICIT NONE
    53
    … …  
    1816!   -------------
    1917
     18      INCLUDE "netcdf.inc"
    2019      INCLUDE "iotd.h"
    2120
    … …  
    3231      real  px(1000)
    3332      character (len=10) :: nom
    34       real(kind=4) rlon(iim),rlat(jjm),coordv(llm)
     33      real*4 rlon(iim),rlat(jjm),coordv(llm)
    3534
    3635!   Local:
    … …  
    7271      n_names_iotd_def=0
    7372      open(99,file='iotd.def',form='formatted',status='old',iostat=ierr)
    74          if ( ierr==0 ) then
     73         if ( ierr.eq.0 ) then
    7574            ierr=0
    7675            do while (ierr==0)
    … …  
    113112      ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',12,"degrees_east")
    114113      ierr=NF_ENDDEF(nid)
    115       ierr=nf90_put_var(nid,nvarid,rlon)
     114      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlon)
    116115       print*,ierr
    117116
    … …  
    122121      ierr=NF_PUT_ATT_TEXT(nid,nvarid,'units',13,"degrees_north")
    123122      ierr=NF_ENDDEF(nid)
    124       ierr=nf90_put_var(nid,nvarid,rlat)
     123      ierr=NF_PUT_VAR_REAL(nid,nvarid,rlat)
    125124!
    126125! ---- vertical ------------
    … …  
    136135      endif
    137136      ierr=NF_ENDDEF(nid)
    138       ierr=nf90_put_var(nid,nvarid,coordv)
     137      ierr=NF_PUT_VAR_REAL(nid,nvarid,coordv)
    139138
    140139!

  • LMDZ6/trunk/libf/phylmd/limit_read_mod.F90

    r5075 r5084  
    165165    USE mod_phys_lmdz_para
    166166    USE surface_data, ONLY : type_ocean, ok_veget
    167     USE lmdz_netcdf, ONLY:nf90_get_var,nf90_inq_varid,nf90_close,nf90_inquire_dimension,&
    168             nf90_inquire,nf90_get_att,nf90_inq_dimid,nf90_nowrite,nf90_noerr,nf90_open
     167    USE netcdf
    169168    USE indice_sol_mod
    170169    USE phys_cal_mod, ONLY : calend, year_len

  • LMDZ6/trunk/libf/phylmd/limit_slab.F90

    r5075 r5084  
    66  USE mod_grid_phy_lmdz, ONLY: klon_glo
    77  USE mod_phys_lmdz_para
    8   USE lmdz_netcdf, ONLY: nf90_close,nf90_get_var,nf90_inq_varid,nf90_nowrite,nf90_noerr,nf90_open
     8  USE netcdf
    99  USE indice_sol_mod
    1010  USE ocean_slab_mod, ONLY: nslay
    … …  
    9999        END IF
    100100        ! Try next layers if more than 1
    101         IF ((nslay>1).AND.read_bils) THEN
     101        IF ((nslay.GT.1).AND.read_bils) THEN
    102102          DO i=2,nslay
    103103            WRITE(str2,'(i2.2)') i
    104104            ierr = NF90_INQ_VARID(nid,'BILS_OCE'//str2, nvarid)
    105             IF (ierr==NF90_NOERR) THEN
     105            IF (ierr.EQ.NF90_NOERR) THEN
    106106              ierr = NF90_GET_VAR(nid,nvarid,bils_glo(:,i),start,epais)
    107107            ENDIF

  • LMDZ6/trunk/libf/phylmd/mo_simple_plumes.F90

    r5075 r5084  
    2424MODULE MO_SIMPLE_PLUMES
    2525
    26     USE lmdz_netcdf, ONLY:nf90_get_var,nf90_close,nf90_inq_varid,nf90_inq_dimid,&
    27             nf90_inquire_dimension,nf90_noerr,nf90_nowrite,nf90_open
     26  USE netcdf
    2827
    2928  IMPLICIT NONE

  • LMDZ6/trunk/libf/phylmd/moy_undefSTD.F90

    r5075 r5084  
    33
    44SUBROUTINE moy_undefstd(itap, itapm1)
    5   USE lmdz_netcdf, ONLY: nf90_fill_real
     5  USE netcdf
    66  USE dimphy
    77#ifdef CPP_IOIPSL

  • LMDZ6/trunk/libf/phylmd/open_climoz_m.F90

    r5075 r5084  
    1313!-------------------------------------------------------------------------------
    1414  USE netcdf95, ONLY: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
    15   USE lmdz_netcdf,   ONLY: nf90_nowrite
     15  USE netcdf,   ONLY: nf90_nowrite
    1616  USE mod_phys_lmdz_mpi_data,      ONLY: is_mpi_root
    1717  USE mod_phys_lmdz_mpi_transfert, ONLY: bcast_mpi

  • LMDZ6/trunk/libf/phylmd/pbl_surface_mod.F90

    r5075 r5084  
    415415    use lmdz_blowing_snow_ini, only : zeta_bs
    416416    USE wxios, ONLY: missing_val_xios => missing_val, using_xios
    417     USE lmdz_netcdf, only: missing_val_netcdf => nf90_fill_real
     417    USE netcdf, only: missing_val_netcdf => nf90_fill_real
    418418
    419419     

  • LMDZ6/trunk/libf/phylmd/phyaqua_mod.F90

    r5073 r5084  
    133133    !END IF
    134134   
    135     if (year_len/=360) then
     135    if (year_len.ne.360) then
    136136      write (*,*) year_len
    137137      call abort_physic("iniaqua", 'iniaqua: 360 day calendar is required !', 1)
    … …  
    517517    IMPLICIT NONE
    518518
     519    include "netcdf.inc"
     520
    519521    INTEGER, INTENT (IN) :: klon
    520522    REAL, INTENT (IN) :: phy_nat(klon, 360)
    … …  
    570572    USE mod_phys_lmdz_transfert_para, ONLY: gather
    571573    USE phys_cal_mod, ONLY: year_len
    572     use lmdz_netcdf, ONLY: nf90_def_var, nf90_put_var, nf90_get_var, nf_strerror, nf_close, &
    573             nf_enddef, nf_put_att_text, nf_unlimited, nf_noerr, nf_global, nf_clobber, &
    574             nf_64bit_offset, nf90_format, nf_def_dim, nf_create
     574    use netcdf, only: nf90_def_var, nf90_double, nf90_float
    575575    IMPLICIT NONE
     576    include "netcdf.inc"
    576577
    577578    INTEGER, INTENT (IN) :: klon
    … …  
    615616      dims(2) = ntim
    616617
    617       ierr = nf90_def_var(nid, 'TEMPS', NF90_FORMAT, [ntim], id_tim)
     618#ifdef NC_DOUBLE
     619      ierr = nf90_def_var(nid, 'TEMPS', nf90_double, [ntim], id_tim)
     620#else
     621      ierr = nf90_def_var(nid, 'TEMPS', nf90_float, [ntim], id_tim)
     622#endif
    618623      ierr = nf_put_att_text(nid, id_tim, 'title', 17, 'Jour dans l annee')
    619624
    620       ierr = nf90_def_var(nid, 'NAT', NF90_FORMAT, dims, id_nat)
     625#ifdef NC_DOUBLE
     626      ierr = nf90_def_var(nid, 'NAT', nf90_double, dims, id_nat)
     627#else
     628      ierr = nf90_def_var(nid, 'NAT', nf90_float, dims, id_nat)
     629#endif
    621630      ierr = nf_put_att_text(nid, id_nat, 'title', 23, &
    622631        'Nature du sol (0,1,2,3)')
    623632
    624       ierr = nf90_def_var(nid, 'SST', NF90_FORMAT, dims, id_sst)
     633#ifdef NC_DOUBLE
     634      ierr = nf90_def_var(nid, 'SST', nf90_double, dims, id_sst)
     635#else
     636      ierr = nf90_def_var(nid, 'SST', nf90_float, dims, id_sst)
     637#endif
    625638      ierr = nf_put_att_text(nid, id_sst, 'title', 35, &
    626639        'Temperature superficielle de la mer')
    627640
    628       ierr = nf90_def_var(nid, 'BILS', NF90_FORMAT, dims, id_bils)
     641#ifdef NC_DOUBLE
     642      ierr = nf90_def_var(nid, 'BILS', nf90_double, dims, id_bils)
     643#else
     644      ierr = nf90_def_var(nid, 'BILS', nf90_float, dims, id_bils)
     645#endif
    629646      ierr = nf_put_att_text(nid, id_bils, 'title', 32, &
    630647        'Reference flux de chaleur au sol')
    631648
    632       ierr = nf90_def_var(nid, 'ALB', NF90_FORMAT, dims, id_alb)
     649#ifdef NC_DOUBLE
     650      ierr = nf90_def_var(nid, 'ALB', nf90_double, dims, id_alb)
     651#else
     652      ierr = nf90_def_var(nid, 'ALB', nf90_float, dims, id_alb)
     653#endif
    633654      ierr = nf_put_att_text(nid, id_alb, 'title', 19, 'Albedo a la surface')
    634655
    635       ierr = nf90_def_var(nid, 'RUG', NF90_FORMAT, dims, id_rug)
     656#ifdef NC_DOUBLE
     657      ierr = nf90_def_var(nid, 'RUG', nf90_double, dims, id_rug)
     658#else
     659      ierr = nf90_def_var(nid, 'RUG', nf90_float, dims, id_rug)
     660#endif
    636661      ierr = nf_put_att_text(nid, id_rug, 'title', 8, 'Rugosite')
    637662
    638       ierr = nf90_def_var(nid, 'FTER', NF90_FORMAT, dims, id_fter)
     663#ifdef NC_DOUBLE
     664      ierr = nf90_def_var(nid, 'FTER', nf90_double, dims, id_fter)
     665#else
     666      ierr = nf90_def_var(nid, 'FTER', nf90_float, dims, id_fter)
     667#endif
    639668      ierr = nf_put_att_text(nid, id_fter, 'title',10,'Frac. Land')
    640       ierr = nf90_def_var(nid, 'FOCE', NF90_FORMAT, dims, id_foce)
     669#ifdef NC_DOUBLE
     670      ierr = nf90_def_var(nid, 'FOCE', nf90_double, dims, id_foce)
     671#else
     672      ierr = nf90_def_var(nid, 'FOCE', nf90_float, dims, id_foce)
     673#endif
    641674      ierr = nf_put_att_text(nid, id_foce, 'title',11,'Frac. Ocean')
    642       ierr = nf90_def_var(nid, 'FSIC', NF90_FORMAT, dims, id_fsic)
     675#ifdef NC_DOUBLE
     676      ierr = nf90_def_var(nid, 'FSIC', nf90_double, dims, id_fsic)
     677#else
     678      ierr = nf90_def_var(nid, 'FSIC', nf90_float, dims, id_fsic)
     679#endif
    643680      ierr = nf_put_att_text(nid, id_fsic, 'title',13,'Frac. Sea Ice')
    644       ierr = nf90_def_var(nid, 'FLIC', NF90_FORMAT, dims, id_flic)
     681#ifdef NC_DOUBLE
     682      ierr = nf90_def_var(nid, 'FLIC', nf90_double, dims, id_flic)
     683#else
     684      ierr = nf90_def_var(nid, 'FLIC', nf90_float, dims, id_flic)
     685#endif
    645686      ierr = nf_put_att_text(nid, id_flic, 'title',14,'Frac. Land Ice')
    646687
    … …  
    654695      ! write the 'times'
    655696      DO k = 1, year_len
    656         ierr = nf90_put_var(nid, id_tim, k, [k])
     697#ifdef NC_DOUBLE
     698        ierr = nf_put_var1_double(nid, id_tim, k, dble(k))
     699#else
     700        ierr = nf_put_var1_real(nid, id_tim, k, float(k))
     701#endif
    657702        IF (ierr/=nf_noerr) THEN
    658703          WRITE (*, *) 'writelim error with temps(k),k=', k
    … …  
    667712    CALL gather(phy_nat, phy_glo)
    668713    IF (is_master) THEN
    669       ierr = nf90_put_var(nid, id_nat, phy_glo)
     714#ifdef NC_DOUBLE
     715      ierr = nf_put_var_double(nid, id_nat, phy_glo)
     716#else
     717      ierr = nf_put_var_real(nid, id_nat, phy_glo)
     718#endif
    670719      IF (ierr/=nf_noerr) THEN
    671720        WRITE (*, *) 'writelim error with phy_nat'
    … …  
    676725    CALL gather(phy_sst, phy_glo)
    677726    IF (is_master) THEN
    678       ierr = nf90_put_var(nid, id_sst, phy_glo)
     727#ifdef NC_DOUBLE
     728      ierr = nf_put_var_double(nid, id_sst, phy_glo)
     729#else
     730      ierr = nf_put_var_real(nid, id_sst, phy_glo)
     731#endif
    679732      IF (ierr/=nf_noerr) THEN
    680733        WRITE (*, *) 'writelim error with phy_sst'
    … …  
    685738    CALL gather(phy_bil, phy_glo)
    686739    IF (is_master) THEN
    687       ierr = nf90_put_var(nid, id_bils, phy_glo)
     740#ifdef NC_DOUBLE
     741      ierr = nf_put_var_double(nid, id_bils, phy_glo)
     742#else
     743      ierr = nf_put_var_real(nid, id_bils, phy_glo)
     744#endif
    688745      IF (ierr/=nf_noerr) THEN
    689746        WRITE (*, *) 'writelim error with phy_bil'
    … …  
    694751    CALL gather(phy_alb, phy_glo)
    695752    IF (is_master) THEN
    696       ierr = nf90_put_var(nid, id_alb, phy_glo)
     753#ifdef NC_DOUBLE
     754      ierr = nf_put_var_double(nid, id_alb, phy_glo)
     755#else
     756      ierr = nf_put_var_real(nid, id_alb, phy_glo)
     757#endif
    697758      IF (ierr/=nf_noerr) THEN
    698759        WRITE (*, *) 'writelim error with phy_alb'
    … …  
    703764    CALL gather(phy_rug, phy_glo)
    704765    IF (is_master) THEN
    705       ierr = nf90_put_var(nid, id_rug, phy_glo)
     766#ifdef NC_DOUBLE
     767      ierr = nf_put_var_double(nid, id_rug, phy_glo)
     768#else
     769      ierr = nf_put_var_real(nid, id_rug, phy_glo)
     770#endif
    706771      IF (ierr/=nf_noerr) THEN
    707772        WRITE (*, *) 'writelim error with phy_rug'
    … …  
    712777    CALL gather(phy_fter, phy_glo)
    713778    IF (is_master) THEN
    714       ierr = nf90_put_var(nid, id_fter, phy_glo)
     779#ifdef NC_DOUBLE
     780      ierr = nf_put_var_double(nid, id_fter, phy_glo)
     781#else
     782      ierr = nf_put_var_real(nid, id_fter, phy_glo)
     783#endif
    715784      IF (ierr/=nf_noerr) THEN
    716785        WRITE (*, *) 'writelim error with phy_fter'
    … …  
    721790    CALL gather(phy_foce, phy_glo)
    722791    IF (is_master) THEN
    723       ierr = nf90_put_var(nid, id_foce, phy_glo)
     792#ifdef NC_DOUBLE
     793      ierr = nf_put_var_double(nid, id_foce, phy_glo)
     794#else
     795      ierr = nf_put_var_real(nid, id_foce, phy_glo)
     796#endif
    724797      IF (ierr/=nf_noerr) THEN
    725798        WRITE (*, *) 'writelim error with phy_foce'
    … …  
    730803    CALL gather(phy_fsic, phy_glo)
    731804    IF (is_master) THEN
    732       ierr = nf90_put_var(nid, id_fsic, phy_glo)
     805#ifdef NC_DOUBLE
     806      ierr = nf_put_var_double(nid, id_fsic, phy_glo)
     807#else
     808      ierr = nf_put_var_real(nid, id_fsic, phy_glo)
     809#endif
    733810      IF (ierr/=nf_noerr) THEN
    734811        WRITE (*, *) 'writelim error with phy_fsic'
    … …  
    739816    CALL gather(phy_flic, phy_glo)
    740817    IF (is_master) THEN
    741       ierr = nf90_put_var(nid, id_flic, phy_glo)
     818#ifdef NC_DOUBLE
     819      ierr = nf_put_var_double(nid, id_flic, phy_glo)
     820#else
     821      ierr = nf_put_var_real(nid, id_flic, phy_glo)
     822#endif
    742823      IF (ierr/=nf_noerr) THEN
    743824        WRITE (*, *) 'writelim error with phy_flic'
    … …  
    9391020      END IF
    9401021
    941       if (type_profil==20) then
     1022      if (type_profil.EQ.20) then
    9421023      print*,'Profile SST 20'
    9431024!     Méthode 13 "Qmax2K" plateau réel �|  l'Equateur augmenté +2K
    … …  
    9481029      endif
    9491030
    950       if (type_profil==21) then
     1031      if (type_profil.EQ.21) then
    9511032      print*,'Profile SST 21'
    9521033!     Méthode 13 "Qmax2K" plateau réel �|  l'Equateur augmenté +2K

  • LMDZ6/trunk/libf/phylmd/phyetat0_mod.F90

    r5075 r5084  
    4040  USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
    4141  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
    42   use lmdz_netcdf, only: missing_val_netcdf => nf90_fill_real
     42  use netcdf, only: missing_val_netcdf => nf90_fill_real
    4343  use config_ocean_skin_m, only: activate_ocean_skin
    4444
    … …  
    152152  tab_cntrl(6)=nbapp_rad
    153153
    154   IF (iflag_cycle_diurne>=1) tab_cntrl( 7) = iflag_cycle_diurne
     154  IF (iflag_cycle_diurne.GE.1) tab_cntrl( 7) = iflag_cycle_diurne
    155155  IF (soil_model) tab_cntrl( 8) =1.
    156156  IF (new_oliq) tab_cntrl( 9) =1.
    … …  
    251251       + pctsrf(1 : klon, is_lic)
    252252  DO i = 1 , klon
    253      IF ( abs(fractint(i) - zmasq(i) ) > EPSFRA ) THEN
     253     IF ( abs(fractint(i) - zmasq(i) ) .GT. EPSFRA ) THEN
    254254        WRITE(*, *) 'phyetat0: attention fraction terre pas ',  &
    255255             'coherente ', i, zmasq(i), pctsrf(i, is_ter) &
    … …  
    262262       + pctsrf(1 : klon, is_sic)
    263263  DO i = 1 , klon
    264      IF ( abs( fractint(i) - (1. - zmasq(i))) > EPSFRA ) THEN
     264     IF ( abs( fractint(i) - (1. - zmasq(i))) .GT. EPSFRA ) THEN
    265265        WRITE(*, *) 'phyetat0 attention fraction ocean pas ',  &
    266266             'coherente ', i, zmasq(i) , pctsrf(i, is_oce) &
    … …  
    290290  DO nsrf = 1, nbsrf
    291291     DO isw=1, nsw
    292         IF (isw>99) THEN
     292        IF (isw.GT.99) THEN
    293293           PRINT*, "Trop de bandes SW"
    294294           call abort_physic("phyetat0", "", 1)
    … …  
    313313
    314314   DO isoil=1, nsoilmx
    315         IF (isoil>99) THEN
     315        IF (isoil.GT.99) THEN
    316316           PRINT*, "Trop de couches "
    317317           call abort_physic("phyetat0", "", 1)
    … …  
    416416  !          dummy values (as is the case when generated by ce0l,
    417417  !          or by iniaqua)
    418   IF ( (maxval(q_ancien)==minval(q_ancien))       .OR. &
    419        (maxval(ql_ancien)==minval(ql_ancien))     .OR. &
    420        (maxval(qs_ancien)==minval(qs_ancien))     .OR. &
    421        (maxval(rneb_ancien)==minval(rneb_ancien)) .OR. &
    422        (maxval(prw_ancien)==minval(prw_ancien))   .OR. &
    423        (maxval(prlw_ancien)==minval(prlw_ancien)) .OR. &
    424        (maxval(prsw_ancien)==minval(prsw_ancien)) .OR. &
    425        (maxval(t_ancien)==minval(t_ancien)) ) THEN
     418  IF ( (maxval(q_ancien).EQ.minval(q_ancien))       .OR. &
     419       (maxval(ql_ancien).EQ.minval(ql_ancien))     .OR. &
     420       (maxval(qs_ancien).EQ.minval(qs_ancien))     .OR. &
     421       (maxval(rneb_ancien).EQ.minval(rneb_ancien)) .OR. &
     422       (maxval(prw_ancien).EQ.minval(prw_ancien))   .OR. &
     423       (maxval(prlw_ancien).EQ.minval(prlw_ancien)) .OR. &
     424       (maxval(prsw_ancien).EQ.minval(prsw_ancien)) .OR. &
     425       (maxval(t_ancien).EQ.minval(t_ancien)) ) THEN
    426426    ancien_ok=.false.
    427427  ENDIF
    428428
    429429  IF (ok_bs) THEN
    430     IF ( (maxval(qbs_ancien)==minval(qbs_ancien))       .OR. &
    431          (maxval(prbsw_ancien)==minval(prbsw_ancien)) ) THEN
     430    IF ( (maxval(qbs_ancien).EQ.minval(qbs_ancien))       .OR. &
     431         (maxval(prbsw_ancien).EQ.minval(prbsw_ancien)) ) THEN
    432432       ancien_ok=.false.
    433433    ENDIF
    … …  
    549549  IF ( type_ocean == 'slab' ) THEN
    550550      CALL ocean_slab_init(phys_tstep, pctsrf)
    551       IF (nslay==1) THEN
     551      IF (nslay.EQ.1) THEN
    552552        found=phyetat0_get(tslab,["tslab01","tslab  "],"tslab",0.)
    553553      ELSE
    … …  
    578578              PRINT*, "Initialisation a 0/1m suivant fraction glace"
    579579              seaice(:)=0.
    580               WHERE (pctsrf(:,is_sic)>EPSFRA)
     580              WHERE (pctsrf(:,is_sic).GT.EPSFRA)
    581581                  seaice=917.
    582582              ENDWHERE

  • LMDZ6/trunk/libf/phylmd/phys_local_var_mod.F90

    r5066 r5084  
    352352!$OMP THREADPRIVATE(d_deltat_vdf, d_deltaq_vdf)
    353353!!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: d_s_vdf, d_dens_vdf
    354 !!!$OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)
     354!!!OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)
    355355    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:)          :: d_deltat_the, d_deltaq_the
    356356!$OMP THREADPRIVATE(d_deltat_the, d_deltaq_the)
    357357!!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: d_s_the, d_dens_the
    358 !!!$OMP THREADPRIVATE(d_s_the, d_dens_the)
     358!!!OMP THREADPRIVATE(d_s_the, d_dens_the)
    359359      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
    360360!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)

  • LMDZ6/trunk/libf/phylmd/phys_output_write_mod.F90

    r5075 r5084  
    456456    USE ioipsl, ONLY: histend, histsync
    457457    USE iophy, ONLY: set_itau_iophy, histwrite_phy
    458     USE lmdz_netcdf, ONLY: nf90_fill_real
     458    USE netcdf, ONLY: nf90_fill_real
    459459    USE print_control_mod, ONLY: prt_level,lunout
    460460    ! ug Pour les sorties XIOS
    … …  
    555555      kmax_100m=1
    556556      DO k=1, klev-1
    557         IF (presnivs(k)>0.97*101325.) kmax_100m = k !--finding out max level for 100 m with a good margin
     557        IF (presnivs(k).GT.0.97*101325.) kmax_100m = k !--finding out max level for 100 m with a good margin
    558558      ENDDO
    559559    ENDIF
    … …  
    782782          DO k=1, kmax_100m-1                                      !--we could stop much lower
    783783            DO i=1,klon
    784               IF (z(i,k)<100..AND.z(i,k+1)>=100.) THEN
     784              IF (z(i,k).LT.100..AND.z(i,k+1).GE.100.) THEN
    785785                wind100m(i)=SQRT( (u_seri(i,k)+(100.-z(i,k))/(z(i,k+1)-z(i,k))*(u_seri(i,k+1)-u_seri(i,k)))**2.0 + &
    786786                                  (v_seri(i,k)+(100.-z(i,k))/(z(i,k+1)-z(i,k))*(v_seri(i,k+1)-v_seri(i,k)))**2.0 )
    … …  
    794794         !--polynomial fit for 14,Vestas,1074,V136/3450 kW windmill - Olivier
    795795         DO i=1,klon
    796            IF (pctsrf(i,is_ter)>0.05 .AND. wind100m(i)/=missing_val) THEN
     796           IF (pctsrf(i,is_ter).GT.0.05 .AND. wind100m(i).NE.missing_val) THEN
    797797             x=wind100m(i)
    798              IF (x<=3.0 .OR. x>=22.5) THEN
     798             IF (x.LE.3.0 .OR. x.GE.22.5) THEN
    799799               zx_tmp_fi2d(i)=0.0
    800              ELSE IF (x>=10.0) THEN
     800             ELSE IF (x.GE.10.0) THEN
    801801               zx_tmp_fi2d(i)=1.0
    802802             ELSE
    … …  
    815815         !--polynomial fit for 14,Vestas,867,V164/8000 kW - Olivier
    816816         DO i=1,klon
    817            IF (pctsrf(i,is_oce)>0.05 .AND. wind100m(i)/=missing_val) THEN
     817           IF (pctsrf(i,is_oce).GT.0.05 .AND. wind100m(i).NE.missing_val) THEN
    818818             x=wind100m(i)
    819              IF (x<=3.0 .OR. x>=25.5) THEN
     819             IF (x.LE.3.0 .OR. x.GE.25.5) THEN
    820820               zx_tmp_fi2d(i)=0.0
    821              ELSE IF (x>=12.5) THEN
     821             ELSE IF (x.GE.12.5) THEN
    822822               zx_tmp_fi2d(i)=1.0
    823823             ELSE
    … …  
    14071407       CALL histwrite_phy(o_uwat, uwat)
    14081408       CALL histwrite_phy(o_vwat, vwat)
    1409        IF (iflag_con>=3) THEN ! sb
     1409       IF (iflag_con.GE.3) THEN ! sb
    14101410          CALL histwrite_phy(o_cape, cape)
    14111411          CALL histwrite_phy(o_pbase, ema_pcb)
    … …  
    15121512            DO k=1, nlevSTD
    15131513              bb2=clevSTD(k)
    1514               IF (bb2=="850".OR.bb2=="700".OR. &
    1515                   bb2=="500".OR.bb2=="200".OR. &
    1516                   bb2=="100".OR. &
    1517                   bb2=="50".OR.bb2=="10") THEN
     1514              IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
     1515                  bb2.EQ."500".OR.bb2.EQ."200".OR. &
     1516                  bb2.EQ."100".OR. &
     1517                  bb2.EQ."50".OR.bb2.EQ."10") THEN
    15181518                  ll=ll+1
    15191519                  CALL histwrite_phy(o_uSTDlevs(ll),ulevSTD(:,k))
    … …  
    15301530       IF (vars_defined) THEN
    15311531          DO i=1, klon
    1532              IF (pctsrf(i,is_oce)>epsfra.OR. &
    1533                   pctsrf(i,is_sic)>epsfra) THEN
     1532             IF (pctsrf(i,is_oce).GT.epsfra.OR. &
     1533                  pctsrf(i,is_sic).GT.epsfra) THEN
    15341534                zx_tmp_fi2d(i) = (ftsol(i, is_oce) * pctsrf(i,is_oce)+ &
    15351535                     ftsol(i, is_sic) * pctsrf(i,is_sic))/ &
    … …  
    15431543
    15441544       ! Couplage convection-couche limite
    1545        IF (iflag_con>=3) THEN
     1545       IF (iflag_con.GE.3) THEN
    15461546          IF (iflag_coupl>=1) THEN
    15471547             CALL histwrite_phy(o_ale_bl, ale_bl)
    … …  
    15501550       ENDIF !(iflag_con.GE.3)
    15511551       ! Wakes
    1552        IF (iflag_con==3) THEN
     1552       IF (iflag_con.EQ.3) THEN
    15531553          CALL histwrite_phy(o_Mipsh, Mipsh)
    15541554          IF (iflag_wake>=1) THEN
    … …  
    16201620          CALL histwrite_phy(o_fqd, fqd)
    16211621       ENDIF !(iflag_con.EQ.3)
    1622        IF (iflag_con==3.OR.iflag_con==30) THEN
     1622       IF (iflag_con.EQ.3.OR.iflag_con.EQ.30) THEN
    16231623          ! sortie RomP convection descente insaturee iflag_con=30
    16241624          ! etendue a iflag_con=3 (jyg)
    … …  
    16511651       IF (type_ocean=='slab ') THEN
    16521652          CALL histwrite_phy(o_slab_bils, slab_wfbils)
    1653           IF (nslay==1) THEN
     1653          IF (nslay.EQ.1) THEN
    16541654              IF (vars_defined) zx_tmp_fi2d(:)=tslab(:,1)
    16551655              CALL histwrite_phy(o_tslab, zx_tmp_fi2d)
    … …  
    16691669          ENDIF
    16701670          IF (slab_hdiff) THEN
    1671             IF (nslay==1) THEN
     1671            IF (nslay.EQ.1) THEN
    16721672                IF (vars_defined) zx_tmp_fi2d(:)=dt_hdiff(:,1)
    16731673                CALL histwrite_phy(o_slab_hdiff, zx_tmp_fi2d)
    … …  
    16761676            ENDIF
    16771677          ENDIF
    1678           IF (slab_ekman>0) THEN
    1679             IF (nslay==1) THEN
     1678          IF (slab_ekman.GT.0) THEN
     1679            IF (nslay.EQ.1) THEN
    16801680                IF (vars_defined) zx_tmp_fi2d(:)=dt_ekman(:,1)
    16811681                CALL histwrite_phy(o_slab_ekman, zx_tmp_fi2d)
    … …  
    17021702       IF (vars_defined) THEN
    17031703          DO i=1, klon
    1704              IF (zt2m(i)<=273.15) then
     1704             IF (zt2m(i).LE.273.15) then
    17051705                zx_tmp_fi2d(i)=MAX(0.,rh2m(i)*100.)
    17061706             ELSE
    … …  
    17441744!This is warranted by treating INCA aerosols as offline aerosols
    17451745#ifndef CPP_ECRAD
    1746        IF (flag_aerosol>0) THEN
     1746       IF (flag_aerosol.GT.0) THEN
    17471747          IF (type_trac/='inca' .OR. config_inca=='aeNP') THEN
    17481748
    … …  
    17771777       ENDIF
    17781778       !--STRAT AER
    1779        IF (flag_aerosol>0.OR.flag_aerosol_strat>0) THEN
     1779       IF (flag_aerosol.GT.0.OR.flag_aerosol_strat.GT.0) THEN
    17801780          DO naero = 1, naero_tot
    17811781             CALL histwrite_phy(o_tausumaero(naero),tausum_aero(:,2,naero))
    17821782          ENDDO
    17831783       ENDIF
    1784        IF (flag_aerosol_strat>0) THEN
     1784       IF (flag_aerosol_strat.GT.0) THEN
    17851785          CALL histwrite_phy(o_tausumaero_lw,tausum_aero(:,6,id_STRAT_phy))
    17861786       ENDIF
    … …  
    19331933          CALL histwrite_phy(o_sollwai, zx_tmp_fi2d)
    19341934       ENDIF
    1935        IF (flag_aerosol>0.AND.ok_cdnc) THEN
     1935       IF (flag_aerosol.GT.0.AND.ok_cdnc) THEN
    19361936          CALL histwrite_phy(o_scdnc, scdnc)
    19371937          CALL histwrite_phy(o_cldncl, cldncl)
    … …  
    20022002#endif
    20032003
    2004        IF (flag_aerosol_strat==2) THEN
     2004       IF (flag_aerosol_strat.EQ.2) THEN
    20052005         CALL histwrite_phy(o_stratomask, stratomask)
    20062006       ENDIF
    … …  
    20302030       CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d)
    20312031       CALL histwrite_phy(o_rhum, zx_rh)
    2032        IF (iflag_ice_thermo > 0) THEN
     2032       IF (iflag_ice_thermo .GT. 0) THEN
    20332033          IF (vars_defined) zx_tmp_fi3d = zx_rhl * 100.
    20342034          CALL histwrite_phy(o_rhl, zx_tmp_fi3d)
    … …  
    21112111       CALL histwrite_phy(o_dqlphy2d,  zx_tmp_fi2d)
    21122112
    2113        IF (nqo==3) THEN
     2113       IF (nqo.EQ.3) THEN
    21142114       CALL histwrite_phy(o_dqsphy,  d_qx(:,:,isol))
    21152115       IF (vars_defined) CALL water_int(klon,klev,d_qx(:,:,isol),zmasse,zx_tmp_fi2d)
    … …  
    21952195       ENDIF
    21962196       CALL histwrite_phy(o_dtcon, zx_tmp_fi3d)
    2197        IF (iflag_thermals==0) THEN
     2197       IF (iflag_thermals.EQ.0) THEN
    21982198          IF (vars_defined) THEN
    21992199             zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + &
    … …  
    22012201          ENDIF
    22022202          CALL histwrite_phy(o_tntc, zx_tmp_fi3d)
    2203        ELSE IF(iflag_thermals>=1.AND.iflag_wake==1) THEN
     2203       ELSE IF(iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
    22042204          IF (vars_defined) THEN
    22052205             zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + &
    … …  
    22182218       CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d)
    22192219
    2220        IF (iflag_thermals==0) THEN
     2220       IF (iflag_thermals.EQ.0) THEN
    22212221          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    22222222          CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d)
    2223        ELSE IF (iflag_thermals>=1.AND.iflag_wake==1) THEN
     2223       ELSE IF (iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
    22242224          IF (vars_defined) THEN
    22252225             zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + &
    … …  
    26942694             DO k=1, nlevSTD
    26952695                DO i=1, klon
    2696                    IF (O3STD(i,k)/=missing_val) THEN
     2696                   IF (O3STD(i,k).NE.missing_val) THEN
    26972697                      zx_tmp_fi3d_STD(i,k) = O3STD(i,k) * 1.e+9
    26982698                   ELSE
    … …  
    27072707                DO k=1, nlevSTD
    27082708                   DO i=1, klon
    2709                       IF (O3daySTD(i,k)/=missing_val) THEN
     2709                      IF (O3daySTD(i,k).NE.missing_val) THEN
    27102710                         zx_tmp_fi3d_STD(i,k) = O3daySTD(i,k) * 1.e+9
    27112711                      ELSE

  • LMDZ6/trunk/libf/phylmd/phys_state_var_mod.F90

    r5075 r5084  
    1010! Declaration des variables
    1111      USE dimphy
    12       USE lmdz_netcdf, only: nf90_fill_real
     12      USE netcdf, only: nf90_fill_real
    1313      INTEGER, PARAMETER :: nlevSTD=17
    1414      INTEGER, PARAMETER :: nlevSTD8=8

  • LMDZ6/trunk/libf/phylmd/physiq_mod.F90

    r5075 r5084  
    4848    USE mod_phys_lmdz_para
    4949    USE netcdf95, only: nf95_close
    50     USE lmdz_netcdf, only: nf90_fill_real     ! IM for NMC files
     50    USE netcdf, only: nf90_fill_real     ! IM for NMC files
    5151    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
    5252    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
    … …  
    12501250    !lwoff=y : offset LW CRE for radiation code and other schemes
    12511251    REAL, SAVE :: betalwoff
    1252     !$OMP THREADPRIVATE(betalwoff)
     1252    !OMP THREADPRIVATE(betalwoff)
    12531253!
    12541254    INTEGER :: nbtr_tmp ! Number of tracer inside concvl

  • LMDZ6/trunk/libf/phylmd/plevel.F90

    r5075 r5084  
    77  ! ================================================================
    88  ! ================================================================
    9   USE lmdz_netcdf, ONLY: nf90_fill_real
     9  USE netcdf
    1010  USE dimphy
    1111#ifdef CPP_IOIPSL

  • LMDZ6/trunk/libf/phylmd/plevel_new.F90

    r5075 r5084  
    88  ! ================================================================
    99  ! ================================================================
     10  USE netcdf
    1011  USE dimphy
    1112#ifdef CPP_IOIPSL

  • LMDZ6/trunk/libf/phylmd/press_coefoz_m.F90

    r5075 r5084  
    2424
    2525    use netcdf95, only: nf95_open, nf95_close, nf95_gw_var, nf95_inq_varid
    26     use lmdz_netcdf, only: nf90_nowrite
     26    use netcdf, only: nf90_nowrite
    2727
    2828    use mod_phys_lmdz_mpi_data, only: is_mpi_root

  • LMDZ6/trunk/libf/phylmd/read_map2D.F90

    r5075 r5084  
    33! Return variable for the given timestep.
    44  USE dimphy
    5   USE lmdz_netcdf, ONLY: nf90_open,nf90_close,nf90_nowrite,nf90_noerr,nf90_get_var,nf90_inq_varid
     5  USE netcdf
    66  USE mod_grid_phy_lmdz
    77  USE mod_phys_lmdz_para

  • LMDZ6/trunk/libf/phylmd/read_pstoke.F90

    r5075 r5084  
    1717  ! ******************************************************************************
    1818
    19   USE lmdz_netcdf, ONLY: nf90_open,nf90_inq_varid,nf90_nowrite,nf90_get_var,nf_inq_dim,&
    20           nf_inq_dimid
     19  USE netcdf
    2120  USE dimphy
    2221  USE indice_sol_mod
    … …  
    2423
    2524  IMPLICIT NONE
     25
     26  include "netcdf.inc"
    2627
    2728  INTEGER klono, klevo, imo, jmo

  • LMDZ6/trunk/libf/phylmd/read_pstoke0.F90

    r5075 r5084  
    1616  ! ******************************************************************************
    1717
    18   USE lmdz_netcdf, ONLY: nf_inq_dimid,nf_inq_dim,nf90_get_var,nf90_inq_varid,nf90_open,&
    19           nf90_nowrite
     18  USE netcdf
    2019  USE dimphy
    2120  USE indice_sol_mod
    … …  
    2322
    2423  IMPLICIT NONE
     24
     25  include "netcdf.inc"
    2526
    2627  INTEGER kon, kev, zkon, zkev
    … …  
    252253    ! niveaux de pression
    253254
    254     status = nf90_get_var(ncidp, varidpl, pl, [1], [kev])
     255    status = nf_get_vara_real(ncidp, varidpl, 1, kev, pl)
    255256
    256257    ! lecture de aire et phis
    … …  
    269270    ! **** Geopotentiel au sol ***************************************
    270271    ! phis
    271     status = nf90_get_var(ncidp, varidps, phisfi2, start, count)
     272#ifdef NC_DOUBLE
     273    status = nf_get_vara_double(ncidp, varidps, start, count, phisfi2)
     274#else
     275    status = nf_get_vara_real(ncidp, varidps, start, count, phisfi2)
     276#endif
    272277    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, phisfi2, phisfi)
    273278
    274279    ! **** Aires des mails aux sol ************************************
    275280    ! aire
    276     status = nf90_get_var(ncidp, varidai, airefi2, start, count)
     281#ifdef NC_DOUBLE
     282    status = nf_get_vara_double(ncidp, varidai, start, count, airefi2)
     283#else
     284    status = nf_get_vara_real(ncidp, varidai, start, count, airefi2)
     285#endif
    277286    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, airefi2, airefi)
    278287  ELSE
    … …  
    301310
    302311    ! abder t
    303     status = nf90_get_var(ncidp, varidt, t2, start, count)
     312#ifdef NC_DOUBLE
     313    status = nf_get_vara_double(ncidp, varidt, start, count, t2)
     314#else
     315    status = nf_get_vara_real(ncidp, varidt, start, count, t2)
     316#endif
    304317    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, t2, t)
    305318
    … …  
    307320    ! ********************************************
    308321    ! mfu
    309     status = nf90_get_var(ncidp, varidmfu, mfu2, start, count)
     322#ifdef NC_DOUBLE
     323    status = nf_get_vara_double(ncidp, varidmfu, start, count, mfu2)
     324#else
     325    status = nf_get_vara_real(ncidp, varidmfu, start, count, mfu2)
     326#endif
    310327    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfu2, mfu)
    311328
    312329    ! mfd
    313     status = nf90_get_var(ncidp, varidmfd, mfd2, start, count)
     330#ifdef NC_DOUBLE
     331    status = nf_get_vara_double(ncidp, varidmfd, start, count, mfd2)
     332#else
     333    status = nf_get_vara_real(ncidp, varidmfd, start, count, mfd2)
     334#endif
    314335    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, mfd2, mfd)
    315336
    316337    ! en_u
    317     status = nf90_get_var(ncidp, varidenu, en_u2, start, count)
     338#ifdef NC_DOUBLE
     339    status = nf_get_vara_double(ncidp, varidenu, start, count, en_u2)
     340#else
     341    status = nf_get_vara_real(ncidp, varidenu, start, count, en_u2)
     342#endif
    318343    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_u2, en_u)
    319344
    320345    ! de_u
    321     status = nf90_get_var(ncidp, variddeu, de_u2, start, count)
     346#ifdef NC_DOUBLE
     347    status = nf_get_vara_double(ncidp, variddeu, start, count, de_u2)
     348#else
     349    status = nf_get_vara_real(ncidp, variddeu, start, count, de_u2)
     350#endif
    322351    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_u2, de_u)
    323352
    324353    ! en_d
    325     status = nf90_get_var(ncidp, varidend, en_d2, start, count)
     354#ifdef NC_DOUBLE
     355    status = nf_get_vara_double(ncidp, varidend, start, count, en_d2)
     356#else
     357    status = nf_get_vara_real(ncidp, varidend, start, count, en_d2)
     358#endif
    326359    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_d2, en_d)
    327360
    328361    ! de_d
    329     status = nf90_get_var(ncidp, varidded, de_d2, start, count)
     362#ifdef NC_DOUBLE
     363    status = nf_get_vara_double(ncidp, varidded, start, count, de_d2)
     364#else
     365    status = nf_get_vara_real(ncidp, varidded, start, count, de_d2)
     366#endif
    330367    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, de_d2, de_d)
    331368
    … …  
    334371    ! coefh
    335372    PRINT *, 'LECTURE de coefh a irec =', irec
    336     status = nf90_get_var(ncidp, varidch, coefh2, start, count)
     373#ifdef NC_DOUBLE
     374    status = nf_get_vara_double(ncidp, varidch, start, count, coefh2)
     375#else
     376    status = nf_get_vara_real(ncidp, varidch, start, count, coefh2)
     377#endif
    337378    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, coefh2, coefh)
    338379    ! call dump2d(iip1,jjp1,coefh2(1,2),'COEFH2READ   ')
    … …  
    343384    ! Thermiques
    344385    PRINT *, 'LECTURE de fm_therm a irec =', irec
    345     status = nf90_get_var(ncidp, varidfmth, fm_therm2, start, count)
     386#ifdef NC_DOUBLE
     387    status = nf_get_vara_double(ncidp, varidfmth, start, count, fm_therm2)
     388#else
     389    status = nf_get_vara_real(ncidp, varidfmth, start, count, fm_therm2)
     390#endif
    346391    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, fm_therm2, fm_therm)
    347392    PRINT *, 'LECTURE de en_therm a irec =', irec
    348     status = nf90_get_var(ncidp, varidenth, en_therm2, start, count)
     393#ifdef NC_DOUBLE
     394    status = nf_get_vara_double(ncidp, varidenth, start, count, en_therm2)
     395#else
     396    status = nf_get_vara_real(ncidp, varidenth, start, count, en_therm2)
     397#endif
    349398    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, en_therm2, en_therm)
    350399
    … …  
    352401    ! *******************************************
    353402    ! frac_impa
    354     status = nf90_get_var(ncidp, varidfi, frac_impa2, start, count)
     403#ifdef NC_DOUBLE
     404    status = nf_get_vara_double(ncidp, varidfi, start, count, frac_impa2)
     405#else
     406    status = nf_get_vara_real(ncidp, varidfi, start, count, frac_impa2)
     407#endif
    355408    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_impa2, frac_impa)
    356409
    357410    ! frac_nucl
    358411
    359     status = nf90_get_var(ncidp, varidfn, frac_nucl2, start, count)
     412#ifdef NC_DOUBLE
     413    status = nf_get_vara_double(ncidp, varidfn, start, count, frac_nucl2)
     414#else
     415    status = nf_get_vara_real(ncidp, varidfn, start, count, frac_nucl2)
     416#endif
    360417    CALL gr_ecrit_fi(kev, kon, nbp_lon, nbp_lat, frac_nucl2, frac_nucl)
    361418
    … …  
    369426    ! pyu1
    370427    PRINT *, 'LECTURE de yu1 a irec =', irec
    371     status = nf90_get_var(ncidp, varidyu1, pyu12, start, count)
     428#ifdef NC_DOUBLE
     429    status = nf_get_vara_double(ncidp, varidyu1, start, count, pyu12)
     430#else
     431    status = nf_get_vara_real(ncidp, varidyu1, start, count, pyu12)
     432#endif
    372433    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyu12, pyu1)
    373434
    374435    ! pyv1
    375436    PRINT *, 'LECTURE de yv1 a irec =', irec
    376     status = nf90_get_var(ncidp, varidyv1, pyv12, start, count)
     437#ifdef NC_DOUBLE
     438    status = nf_get_vara_double(ncidp, varidyv1, start, count, pyv12)
     439#else
     440    status = nf_get_vara_real(ncidp, varidyv1, start, count, pyv12)
     441#endif
    377442    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, pyv12, pyv1)
    378443
    … …  
    380445    ! ftsol1
    381446    PRINT *, 'LECTURE de ftsol1 a irec =', irec
    382     status = nf90_get_var(ncidp, varidfts1, ftsol12, start, count)
     447#ifdef NC_DOUBLE
     448    status = nf_get_vara_double(ncidp, varidfts1, start, count, ftsol12)
     449#else
     450    status = nf_get_vara_real(ncidp, varidfts1, start, count, ftsol12)
     451#endif
    383452    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol12, ftsol1)
    384453
    385454    ! ftsol2
    386455    PRINT *, 'LECTURE de ftsol2 a irec =', irec
    387     status = nf90_get_var(ncidp, varidfts2, ftsol22, start, count)
     456#ifdef NC_DOUBLE
     457    status = nf_get_vara_double(ncidp, varidfts2, start, count, ftsol22)
     458#else
     459    status = nf_get_vara_real(ncidp, varidfts2, start, count, ftsol22)
     460#endif
    388461    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol22, ftsol2)
    389462
    390463    ! ftsol3
    391464    PRINT *, 'LECTURE de ftsol3 a irec =', irec
    392     status = nf90_get_var(ncidp, varidfts3, ftsol32, start, count)
     465#ifdef NC_DOUBLE
     466    status = nf_get_vara_double(ncidp, varidfts3, start, count, ftsol32)
     467#else
     468    status = nf_get_vara_real(ncidp, varidfts3, start, count, ftsol32)
     469#endif
    393470    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol32, ftsol3)
    394471
    395472    ! ftsol4
    396     status = nf90_get_var(ncidp, varidfts4, ftsol42, start, count)
     473#ifdef NC_DOUBLE
     474    status = nf_get_vara_double(ncidp, varidfts4, start, count, ftsol42)
     475#else
     476    status = nf_get_vara_real(ncidp, varidfts4, start, count, ftsol42)
     477#endif
    397478    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, ftsol42, ftsol4)
    398479
    399480    ! **** Nature sol ********************************************
    400481    ! psrf1
    401     status = nf90_get_var(ncidp, varidpsr1, psrf12, start, count)
     482#ifdef NC_DOUBLE
     483    status = nf_get_vara_double(ncidp, varidpsr1, start, count, psrf12)
     484#else
     485    status = nf_get_vara_real(ncidp, varidpsr1, start, count, psrf12)
     486#endif
    402487    ! call dump2d(iip1-1,jjm+1,psrf12,'PSRF1NC')
    403488    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf12, psrf1)
    404489
    405490    ! psrf2
    406     status = nf90_get_var(ncidp, varidpsr2, psrf22, start, count)
     491#ifdef NC_DOUBLE
     492    status = nf_get_vara_double(ncidp, varidpsr2, start, count, psrf22)
     493#else
     494    status = nf_get_vara_real(ncidp, varidpsr2, start, count, psrf22)
     495#endif
    407496    ! call dump2d(iip1-1,jjm+1,psrf22,'PSRF2NC')
    408497    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf22, psrf2)
    409498
    410499    ! psrf3
    411     status = nf90_get_var(ncidp, varidpsr3, psrf32, start, count)
     500#ifdef NC_DOUBLE
     501    status = nf_get_vara_double(ncidp, varidpsr3, start, count, psrf32)
     502#else
     503    status = nf_get_vara_real(ncidp, varidpsr3, start, count, psrf32)
     504#endif
    412505    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf32, psrf3)
    413506
    414507    ! psrf4
    415     status = nf90_get_var(ncidp, varidpsr4, psrf42, start, count)
     508#ifdef NC_DOUBLE
     509    status = nf_get_vara_double(ncidp, varidpsr4, start, count, psrf42)
     510#else
     511    status = nf_get_vara_real(ncidp, varidpsr4, start, count, psrf42)
     512#endif
    416513    CALL gr_ecrit_fi(1, kon, nbp_lon, nbp_lat, psrf42, psrf4)
    417514

  • LMDZ6/trunk/libf/phylmd/readaerosol_mod.F90

    r5075 r5084  
    22!
    33MODULE readaerosol_mod
    4 
    5   USE lmdz_netcdf, ONLY: nf90_strerror,nf90_noerr,nf90_get_var,nf90_inq_varid,&
    6           nf90_inquire_dimension,nf90_inq_dimid,nf90_open,nf90_nowrite,nf90_close
    74
    85  REAL, SAVE :: not_valid=-333.
    … …  
    8986! Read data depending on actual year and interpolate if necessary
    9087!****************************************************************************************
    91      IF (iyr_in < 1850) THEN
     88     IF (iyr_in .LT. 1850) THEN
    9289        cyear='.nat'
    9390        WRITE(lunout,*) 'get_aero 1 iyr_in=', iyr_in,'   ',cyear
    … …  
    9693        CALL get_aero_fromfile(name_aero, cyear, filename, klev_src, pt_ap, pt_b, pt_out, psurf, load)
    9794       
    98      ELSE IF (iyr_in >= 2100) THEN
     95     ELSE IF (iyr_in .GE. 2100) THEN
    9996        cyear='2100'
    10097        WRITE(lunout,*) 'get_aero 2 iyr_in=', iyr_in,'   ',cyear
    … …  
    106103        ! Read data from 2 decades and interpolate to actual year
    107104        ! a) from actual 10-yr-period
    108         IF (iyr_in<1900) THEN
     105        IF (iyr_in.LT.1900) THEN
    109106           iyr1 = 1850
    110107           iyr2 = 1900
    111         ELSE IF (iyr_in>=1900.AND.iyr_in<1920) THEN
     108        ELSE IF (iyr_in.GE.1900.AND.iyr_in.LT.1920) THEN
    112109           iyr1 = 1900
    113110           iyr2 = 1920
    … …  
    177174
    178175SUBROUTINE init_aero_fromfile(flag_aerosol, aerosol_couple)
     176  USE netcdf
    179177  USE mod_phys_lmdz_para
    180178  USE mod_grid_phy_lmdz, ONLY: grid_type, unstructured
    … …  
    267265!****************************************************************************************
    268266
     267    USE netcdf
    269268    USE dimphy
    270269    USE mod_grid_phy_lmdz, ONLY: nbp_lon_=>nbp_lon, nbp_lat_=>nbp_lat, klon_glo, &
    … …  
    508507!****************************************************************************************
    509508          DO imth=1, 12
    510              IF (imth==1) THEN
     509             IF (imth.EQ.1) THEN
    511510                cvar=TRIM(varname)//'JAN'
    512              ELSE IF (imth==2) THEN
     511             ELSE IF (imth.EQ.2) THEN
    513512                cvar=TRIM(varname)//'FEB'
    514              ELSE IF (imth==3) THEN
     513             ELSE IF (imth.EQ.3) THEN
    515514                cvar=TRIM(varname)//'MAR'
    516              ELSE IF (imth==4) THEN
     515             ELSE IF (imth.EQ.4) THEN
    517516                cvar=TRIM(varname)//'APR'
    518              ELSE IF (imth==5) THEN
     517             ELSE IF (imth.EQ.5) THEN
    519518                cvar=TRIM(varname)//'MAY'
    520              ELSE IF (imth==6) THEN
     519             ELSE IF (imth.EQ.6) THEN
    521520                cvar=TRIM(varname)//'JUN'
    522              ELSE IF (imth==7) THEN
     521             ELSE IF (imth.EQ.7) THEN
    523522                cvar=TRIM(varname)//'JUL'
    524              ELSE IF (imth==8) THEN
     523             ELSE IF (imth.EQ.8) THEN
    525524                cvar=TRIM(varname)//'AUG'
    526              ELSE IF (imth==9) THEN
     525             ELSE IF (imth.EQ.9) THEN
    527526                cvar=TRIM(varname)//'SEP'
    528              ELSE IF (imth==10) THEN
     527             ELSE IF (imth.EQ.10) THEN
    529528                cvar=TRIM(varname)//'OCT'
    530              ELSE IF (imth==11) THEN
     529             ELSE IF (imth.EQ.11) THEN
    531530                cvar=TRIM(varname)//'NOV'
    532              ELSE IF (imth==12) THEN
     531             ELSE IF (imth.EQ.12) THEN
    533532                cvar=TRIM(varname)//'DEC'
    534533             END IF
    … …  
    717716
    718717  SUBROUTINE check_err(status,text)
     718    USE netcdf
    719719    USE print_control_mod, ONLY: lunout
    720720    IMPLICIT NONE

  • LMDZ6/trunk/libf/phylmd/readaerosolstrato.F90

    r5075 r5084  
    33    use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    44                        nf95_inq_varid, nf95_open
    5     use lmdz_netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
     5    use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
    66
    77    USE phys_cal_mod, ONLY : mth_cur
    … …  
    6868
    6969!--only read file if beginning of run or start of new month
    70     IF (debut.OR.mth_cur/=mth_pre) THEN
     70    IF (debut.OR.mth_cur.NE.mth_pre) THEN
    7171
    7272!--only root reads
    7373    IF (is_mpi_root.AND.is_omp_root) THEN
    7474
    75     IF (nbands/=2) THEN
     75    IF (nbands.NE.2) THEN
    7676        abort_message='nbands doit etre egal a 2 dans readaerosolstrat'
    7777        CALL abort_physic(modname,abort_message,1)
    … …  
    8383    CALL nf95_gw_var(ncid_in, varid, lev)
    8484    n_lev = size(lev)
    85     IF (n_lev/=klev) THEN
     85    IF (n_lev.NE.klev) THEN
    8686       abort_message='Le nombre de niveaux n est pas egal a klev'
    8787       CALL abort_physic(modname,abort_message,1)
    … …  
    9393    WRITE(lunout,*) 'LAT aerosol strato=', n_lat, latitude
    9494    IF (grid_type/=unstructured) THEN
    95       IF (n_lat/=nbp_lat) THEN
     95      IF (n_lat.NE.nbp_lat) THEN
    9696         abort_message='Le nombre de lat n est pas egal a nbp_lat'
    9797         CALL abort_physic(modname,abort_message,1)
    … …  
    104104    IF (grid_type/=unstructured) THEN
    105105      WRITE(lunout,*) 'LON aerosol strato=', n_lon, longitude
    106       IF (n_lon/=nbp_lon) THEN
     106      IF (n_lon.NE.nbp_lon) THEN
    107107         abort_message='Le nombre de lon n est pas egal a nbp_lon'
    108108         CALL abort_physic(modname,abort_message,1)
    … …  
    114114    n_month = size(time)
    115115    WRITE(lunout,*) 'TIME aerosol strato=', n_month, time
    116     IF (n_month/=12) THEN
     116    IF (n_month.NE.12) THEN
    117117       abort_message='Le nombre de month n est pas egal a 12'
    118118       CALL abort_physic(modname,abort_message,1)
    … …  
    131131
    132132!---select the correct month
    133     IF (mth_cur<1.OR.mth_cur>12) THEN
     133    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
    134134     WRITE(lunout,*) 'probleme avec le mois dans readaerosolstrat =', mth_cur
    135135    ENDIF

  • LMDZ6/trunk/libf/phylmd/readaerosolstrato_m.F90

    r5075 r5084  
    2424
    2525SUBROUTINE init_readaerosolstrato1
    26   USE lmdz_netcdf, ONLY: nf90_nowrite
    27   USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     26  USE netcdf
     27  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
    2828                      nf95_inq_varid, nf95_open
    2929  USE mod_phys_lmdz_para
    … …  
    6767 
    6868SUBROUTINE init_readaerosolstrato2
    69   USE lmdz_netcdf, ONLY: nf90_nowrite
    70   USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     69  USE netcdf
     70  USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, & 
    7171                      nf95_inq_varid, nf95_open
    7272  USE mod_phys_lmdz_para

  • LMDZ6/trunk/libf/phylmd/readchlorophyll.F90

    r5075 r5084  
    88
    99    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, nf95_inq_varid, nf95_open
    10     USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     10    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    1111    USE phys_cal_mod, ONLY: mth_cur
    1212    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid2dto1d_glo
    … …  
    5050
    5151!--only read file if beginning of run or start of new month
    52     IF (debut.OR.mth_cur/=mth_pre) THEN
     52    IF (debut.OR.mth_cur.NE.mth_pre) THEN
    5353
    5454    IF (is_mpi_root.AND.is_omp_root) THEN
    … …  
    5959    CALL nf95_gw_var(ncid_in, varid, longitude)
    6060    n_lon = size(longitude)
    61     IF (n_lon/=nbp_lon) THEN
     61    IF (n_lon.NE.nbp_lon) THEN
    6262       abort_message='Le nombre de lon n est pas egal a nbp_lon'
    6363       CALL abort_physic(modname,abort_message,1)
    … …  
    6767    CALL nf95_gw_var(ncid_in, varid, latitude)
    6868    n_lat = size(latitude)
    69     IF (n_lat/=nbp_lat) THEN
     69    IF (n_lat.NE.nbp_lat) THEN
    7070       abort_message='Le nombre de lat n est pas egal a jnbp_lat'
    7171       CALL abort_physic(modname,abort_message,1)
    … …  
    7575    CALL nf95_gw_var(ncid_in, varid, time)
    7676    n_month = size(time)
    77     IF (n_month/=12) THEN
     77    IF (n_month.NE.12) THEN
    7878       abort_message='Le nombre de month n est pas egal a 12'
    7979       CALL abort_physic(modname,abort_message,1)
    … …  
    9292
    9393!---select the correct month
    94     IF (mth_cur<1.OR.mth_cur>12) THEN
     94    IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
    9595      WRITE(lunout,*)'probleme avec le mois dans readchlorophyll =', mth_cur
    9696    ENDIF
    … …  
    104104!      if(isnan(chlorocon_mois_glo(i)))then ! isnan() is not in the Fortran standard...
    105105!      Another way to check for NaN:
    106        IF (chlorocon_mois_glo(i)/=chlorocon_mois_glo(i)) chlorocon_mois_glo(i)=0.
     106       IF (chlorocon_mois_glo(i).NE.chlorocon_mois_glo(i)) chlorocon_mois_glo(i)=0.
    107107    ENDDO
    108108

  • LMDZ6/trunk/libf/phylmd/regr_horiz_time_climoz_m.F90

    r5075 r5084  
    44  USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, grid_type, unstructured
    55  USE nrtype,            ONLY: pi
    6   USE lmdz_netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_OPEN,   &
     6  USE netcdf,   ONLY: NF90_CLOBBER, NF90_FLOAT,     NF90_OPEN,   &
    77                      NF90_NOWRITE, NF90_NOERR,     NF90_GET_ATT, NF90_GLOBAL
    88  USE netcdf95, ONLY: NF95_DEF_DIM, NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION,    &
    … …  
    702702!
    703703!-------------------------------------------------------------------------------
    704   USE lmdz_netcdf, ONLY: NF90_NOERR, NF90_strerror
     704  USE netcdf, ONLY: NF90_NOERR, NF90_strerror
    705705!-------------------------------------------------------------------------------
    706706! Arguments:

  • LMDZ6/trunk/libf/phylmd/regr_lat_time_coefoz_m.F90

    r5075 r5084  
    4545    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var, &
    4646         nf95_put_var, nf95_gw_var
    47     use lmdz_netcdf, only: nf90_nowrite
     47    use netcdf, only: nf90_nowrite
    4848    use nrtype, only: pi
    4949    use regular_lonlat_mod, only: boundslat_reg, south
    … …  
    245245    use netcdf95, only: nf95_create, nf95_def_dim, nf95_def_var, &
    246246         nf95_put_att, nf95_enddef, nf95_copy_att, nf95_put_var
    247     use lmdz_netcdf, only: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
     247    use netcdf, only: nf90_clobber, nf90_float, nf90_copy_att, nf90_global
    248248    use nrtype, only: pi
    249249    use regular_lonlat_mod, only : lat_reg
    … …  
    328328    subroutine handle_err_copy_att(att_name)
    329329
    330       use lmdz_netcdf, only: nf90_noerr, nf90_strerror
     330      use netcdf, only: nf90_noerr, nf90_strerror
    331331
    332332      character(len=*), intent(in):: att_name

  • LMDZ6/trunk/libf/phylmd/regr_pr_comb_coefoz_m.F90

    r5075 r5084  
    7272
    7373    use netcdf95, only: nf95_open, nf95_close
    74     use lmdz_netcdf, only: nf90_nowrite
     74    use netcdf, only: nf90_nowrite
    7575    use assert_m, only: assert
    7676    use dimphy, only: klon

  • LMDZ6/trunk/libf/phylmd/regr_pr_o3_m.F90

    r5075 r5084  
    2626
    2727    use netcdf95, only: nf95_open, nf95_close, nf95_inq_varid, nf95_get_var
    28     use lmdz_netcdf, only:  nf90_nowrite
     28    use netcdf, only:  nf90_nowrite
    2929    use assert_m, only: assert
    3030    use regr_conserv_m, only: regr_conserv

  • LMDZ6/trunk/libf/phylmd/regr_pr_time_av_m.F90

    r5075 r5084  
    115115  USE netcdf95,       ONLY: NF95_INQ_VARID, NF95_INQUIRE_VARIABLE, &
    116116                            NF95_INQ_DIMID, NF95_INQUIRE_DIMENSION, nf95_get_var
    117   USE lmdz_netcdf,         ONLY: NF90_INQ_VARID, NF90_NOERR
     117  USE netcdf,         ONLY: NF90_INQ_VARID, NF90_NOERR
    118118  USE assert_m,       ONLY: assert
    119119  USE assert_eq_m,    ONLY: assert_eq

  • LMDZ6/trunk/libf/phylmd/rrtm/read_rsun_rrtm.F90

    r5075 r5084  
    88
    99  USE netcdf95, ONLY: nf95_close, nf95_inq_varid, nf95_open, nf95_gw_var
    10   USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     10  USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    1111
    1212  USE phys_cal_mod, ONLY : days_elapsed, year_len

  • LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90

    r5075 r5084  
    77    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    88                        nf95_inq_varid, nf95_open
    9     USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     9    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    1010
    1111    USE phys_cal_mod, ONLY : mth_cur

  • LMDZ6/trunk/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90

    r5075 r5084  
    66    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                        nf95_inq_varid, nf95_open
    8     USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     8    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010    USE phys_cal_mod, ONLY : mth_cur

  • LMDZ6/trunk/libf/phylmd/tracco2i_mod.F90

    r5075 r5084  
    104104
    105105! Initialization of tr_seri(id_CO2) If it is not initialized
    106       IF (MAXVAL(tr_seri(:,:,id_CO2))<1.e-15) THEN
     106      IF (MAXVAL(tr_seri(:,:,id_CO2)).LT.1.e-15) THEN
    107107        tr_seri(:,:,id_CO2)=co2_ppm0*1.e-6/RMD*RMCO2 !--initialised from co2_ppm0 in rdem
    108108      ENDIF
    … …  
    299299!--for every timestep comment out the IF ENDIF statements
    300300!--otherwise this is updated every day
    301     IF (debutphy.OR.day_cur/=day_pre) THEN
     301    IF (debutphy.OR.day_cur.NE.day_pre) THEN
    302302
    303303      CALL gather(tr_seri(:,:,id_CO2),co2_glo)
    … …  
    351351
    352352    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_varid, nf95_open
    353     USE lmdz_netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
     353    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    354354
    355355    USE carbon_cycle_mod, ONLY : fco2_ff, fco2_bb, fco2_land, fco2_ocean
    … …  
    401401        CALL nf95_gw_var(ncid_in, varid, vector)
    402402        n_glo = size(vector)
    403         IF (n_glo/=klon_glo) THEN
     403        IF (n_glo.NE.klon_glo) THEN
    404404           abort_message='sflx_lmdz_co2_ff: le nombre de points n est pas egal a klon_glo'
    405405           CALL abort_physic(modname,abort_message,1)
    … …  
    409409        CALL nf95_gw_var(ncid_in, varid, time)
    410410        n_month = size(time)
    411         IF (n_month/=12) THEN
     411        IF (n_month.NE.12) THEN
    412412           abort_message='sflx_lmdz_co2_ff: le nombre de month n est pas egal a 12'
    413413           CALL abort_physic(modname,abort_message,1)
    … …  
    434434      CALL nf95_gw_var(ncid_in, varid, vector)
    435435      n_glo = size(vector)
    436       IF (n_glo/=klon_glo) THEN
     436      IF (n_glo.NE.klon_glo) THEN
    437437         abort_message='sflx_lmdz_co2_bb: le nombre de points n est pas egal a klon_glo'
    438438         CALL abort_physic(modname,abort_message,1)
    … …  
    442442      CALL nf95_gw_var(ncid_in, varid, time)
    443443      n_month = size(time)
    444       IF (n_month/=12) THEN
     444      IF (n_month.NE.12) THEN
    445445         abort_message='sflx_lmdz_co2_bb: le nombre de month n est pas egal a 12'
    446446         CALL abort_physic(modname,abort_message,1)
    … …  
    474474
    475475!---select the correct month
    476   IF (mth_cur<1.OR.mth_cur>12) THEN
     476  IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
    477477    PRINT *,'probleme avec le mois dans co2_ini =', mth_cur
    478478  ENDIF

  • LMDZ6/trunk/libf/phylmd/undefSTD.F90

    r5075 r5084  
    33
    44SUBROUTINE undefstd(itap, read_climoz)
    5   USE lmdz_netcdf, ONLY: nf90_fill_real
     5  USE netcdf
    66  USE dimphy
    77#ifdef CPP_IOIPSL

  • LMDZ6/trunk/libf/phylmdiso/isotopes_routines_mod.F90

    r5075 r5084  
    1587115871  USE isotopes_verif_mod
    1587215872#endif
     15873
    1587315874       implicit none   
    1587415875
    1587515876      ! equivalent de phyetat0 pour les isotopes 
    1587615877
     15878#include "netcdf.inc"
    1587715879#include "dimsoil.h"
    1587815880#include "clesphys.h"
    … …  
    1642716429   IMPLICIT NONE
    1642816430
     16431#include "netcdf.inc"
    1642916432#include "dimsoil.h"
    1643016433#include "clesphys.h"

  • LMDZ6/trunk/libf/phylmdiso/limit_read_mod.F90

    r5076 r5084  
    274274    USE mod_phys_lmdz_para
    275275    USE surface_data, ONLY : type_ocean, ok_veget
    276     USE lmdz_netcdf, ONLY:nf90_noerr,nf90_close,nf90_get_var,nf90_inq_varid,nf90_nowrite,&
    277             nf90_inq_dimid,nf90_inquire_dimension,nf90_open,nf90_get_att,nf90_inquire
     276    USE netcdf
    278277    USE indice_sol_mod
    279278#ifdef ISO

  • LMDZ6/trunk/libf/phylmdiso/phyaqua_mod.F90

    r5076 r5084  
    147147    !END IF
    148148   
    149     if (year_len/=360) then
     149    if (year_len.ne.360) then
    150150      write (*,*) year_len
    151151      write (*,*) 'iniaqua: 360 day calendar is required !'
    … …  
    539539    IMPLICIT NONE
    540540
     541    include "netcdf.inc"
     542
    541543    INTEGER, INTENT (IN) :: klon
    542544    REAL, INTENT (IN) :: phy_nat(klon, 360)
    … …  
    591593    USE mod_phys_lmdz_transfert_para, ONLY: gather
    592594    USE phys_cal_mod, ONLY: year_len
    593     USE lmdz_netcdf, ONLY:nf_clobber,nf_close,nf_noerr,nf_strerror,nf_put_att_text,nf_def_var,&
    594             nf_def_dim,nf_create,nf90_put_var,nf_unlimited,nf_global,nf_64bit_offset,nf90_format,&
    595             nf_enddef
    596595    IMPLICIT NONE
     596    include "netcdf.inc"
    597597
    598598    INTEGER, INTENT (IN) :: klon
    … …  
    636636      dims(2) = ntim
    637637
    638       ierr = nf_def_var(nid, 'TEMPS', NF90_FORMAT, 1, ntim, id_tim)
     638#ifdef NC_DOUBLE
     639      ierr = nf_def_var(nid, 'TEMPS', nf_double, 1, ntim, id_tim)
     640#else
     641      ierr = nf_def_var(nid, 'TEMPS', nf_float, 1, ntim, id_tim)
     642#endif
    639643      ierr = nf_put_att_text(nid, id_tim, 'title', 17, 'Jour dans l annee')
    640644
    641       ierr = nf_def_var(nid, 'NAT', NF90_FORMAT, 2, dims, id_nat)
     645#ifdef NC_DOUBLE
     646      ierr = nf_def_var(nid, 'NAT', nf_double, 2, dims, id_nat)
     647#else
     648      ierr = nf_def_var(nid, 'NAT', nf_float, 2, dims, id_nat)
     649#endif
    642650      ierr = nf_put_att_text(nid, id_nat, 'title', 23, &
    643651        'Nature du sol (0,1,2,3)')
    644652
    645       ierr = nf_def_var(nid, 'SST', NF90_FORMAT, 2, dims, id_sst)
     653#ifdef NC_DOUBLE
     654      ierr = nf_def_var(nid, 'SST', nf_double, 2, dims, id_sst)
     655#else
     656      ierr = nf_def_var(nid, 'SST', nf_float, 2, dims, id_sst)
     657#endif
    646658      ierr = nf_put_att_text(nid, id_sst, 'title', 35, &
    647659        'Temperature superficielle de la mer')
    648660
    649       ierr = nf_def_var(nid, 'BILS', NF90_FORMAT, 2, dims, id_bils)
     661#ifdef NC_DOUBLE
     662      ierr = nf_def_var(nid, 'BILS', nf_double, 2, dims, id_bils)
     663#else
     664      ierr = nf_def_var(nid, 'BILS', nf_float, 2, dims, id_bils)
     665#endif
    650666      ierr = nf_put_att_text(nid, id_bils, 'title', 32, &
    651667        'Reference flux de chaleur au sol')
    652668
    653       ierr = nf_def_var(nid, 'ALB', NF90_FORMAT, 2, dims, id_alb)
     669#ifdef NC_DOUBLE
     670      ierr = nf_def_var(nid, 'ALB', nf_double, 2, dims, id_alb)
     671#else
     672      ierr = nf_def_var(nid, 'ALB', nf_float, 2, dims, id_alb)
     673#endif
    654674      ierr = nf_put_att_text(nid, id_alb, 'title', 19, 'Albedo a la surface')
    655675
    656       ierr = nf_def_var(nid, 'RUG', NF90_FORMAT, 2, dims, id_rug)
     676#ifdef NC_DOUBLE
     677      ierr = nf_def_var(nid, 'RUG', nf_double, 2, dims, id_rug)
     678#else
     679      ierr = nf_def_var(nid, 'RUG', nf_float, 2, dims, id_rug)
     680#endif
    657681      ierr = nf_put_att_text(nid, id_rug, 'title', 8, 'Rugosite')
    658682
    659       ierr = nf_def_var(nid, 'FTER', NF90_FORMAT, 2, dims, id_fter)
     683#ifdef NC_DOUBLE
     684      ierr = nf_def_var(nid, 'FTER', nf_double, 2, dims, id_fter)
     685#else
     686      ierr = nf_def_var(nid, 'FTER', nf_float, 2, dims, id_fter)
     687#endif
    660688      ierr = nf_put_att_text(nid, id_fter, 'title',10,'Frac. Land')
    661       ierr = nf_def_var(nid, 'FOCE', NF90_FORMAT, 2, dims, id_foce)
     689#ifdef NC_DOUBLE
     690      ierr = nf_def_var(nid, 'FOCE', nf_double, 2, dims, id_foce)
     691#else
     692      ierr = nf_def_var(nid, 'FOCE', nf_float, 2, dims, id_foce)
     693#endif
    662694      ierr = nf_put_att_text(nid, id_foce, 'title',11,'Frac. Ocean')
    663       ierr = nf_def_var(nid, 'FSIC', NF90_FORMAT, 2, dims, id_fsic)
     695#ifdef NC_DOUBLE
     696      ierr = nf_def_var(nid, 'FSIC', nf_double, 2, dims, id_fsic)
     697#else
     698      ierr = nf_def_var(nid, 'FSIC', nf_float, 2, dims, id_fsic)
     699#endif
    664700      ierr = nf_put_att_text(nid, id_fsic, 'title',13,'Frac. Sea Ice')
    665       ierr = nf_def_var(nid, 'FLIC', NF90_FORMAT, 2, dims, id_flic)
     701#ifdef NC_DOUBLE
     702      ierr = nf_def_var(nid, 'FLIC', nf_double, 2, dims, id_flic)
     703#else
     704      ierr = nf_def_var(nid, 'FLIC', nf_float, 2, dims, id_flic)
     705#endif
    666706      ierr = nf_put_att_text(nid, id_flic, 'title',14,'Frac. Land Ice')
    667707
    … …  
    675715      ! write the 'times'
    676716      DO k = 1, year_len
    677         ierr = nf90_put_var(nid, id_tim, k, [k])
     717#ifdef NC_DOUBLE
     718        ierr = nf_put_var1_double(nid, id_tim, k, dble(k))
     719#else
     720        ierr = nf_put_var1_real(nid, id_tim, k, float(k))
     721#endif
    678722        IF (ierr/=nf_noerr) THEN
    679723          WRITE (*, *) 'writelim error with temps(k),k=', k
    … …  
    688732    CALL gather(phy_nat, phy_glo)
    689733    IF (is_master) THEN
    690       ierr = nf90_put_var(nid, id_nat, phy_glo)
     734#ifdef NC_DOUBLE
     735      ierr = nf_put_var_double(nid, id_nat, phy_glo)
     736#else
     737      ierr = nf_put_var_real(nid, id_nat, phy_glo)
     738#endif
    691739      IF (ierr/=nf_noerr) THEN
    692740        WRITE (*, *) 'writelim error with phy_nat'
    … …  
    697745    CALL gather(phy_sst, phy_glo)
    698746    IF (is_master) THEN
    699       ierr = nf90_put_var(nid, id_sst, phy_glo)
     747#ifdef NC_DOUBLE
     748      ierr = nf_put_var_double(nid, id_sst, phy_glo)
     749#else
     750      ierr = nf_put_var_real(nid, id_sst, phy_glo)
     751#endif
    700752      IF (ierr/=nf_noerr) THEN
    701753        WRITE (*, *) 'writelim error with phy_sst'
    … …  
    706758    CALL gather(phy_bil, phy_glo)
    707759    IF (is_master) THEN
    708       ierr = nf90_put_var(nid, id_bils, phy_glo)
     760#ifdef NC_DOUBLE
     761      ierr = nf_put_var_double(nid, id_bils, phy_glo)
     762#else
     763      ierr = nf_put_var_real(nid, id_bils, phy_glo)
     764#endif
    709765      IF (ierr/=nf_noerr) THEN
    710766        WRITE (*, *) 'writelim error with phy_bil'
    … …  
    715771    CALL gather(phy_alb, phy_glo)
    716772    IF (is_master) THEN
    717       ierr = nf90_put_var(nid, id_alb, phy_glo)
     773#ifdef NC_DOUBLE
     774      ierr = nf_put_var_double(nid, id_alb, phy_glo)
     775#else
     776      ierr = nf_put_var_real(nid, id_alb, phy_glo)
     777#endif
    718778      IF (ierr/=nf_noerr) THEN
    719779        WRITE (*, *) 'writelim error with phy_alb'
    … …  
    724784    CALL gather(phy_rug, phy_glo)
    725785    IF (is_master) THEN
    726       ierr = nf90_put_var(nid, id_rug, phy_glo)
     786#ifdef NC_DOUBLE
     787      ierr = nf_put_var_double(nid, id_rug, phy_glo)
     788#else
     789      ierr = nf_put_var_real(nid, id_rug, phy_glo)
     790#endif
    727791      IF (ierr/=nf_noerr) THEN
    728792        WRITE (*, *) 'writelim error with phy_rug'
    … …  
    733797    CALL gather(phy_fter, phy_glo)
    734798    IF (is_master) THEN
    735       ierr = nf90_put_var(nid, id_fter, phy_glo)
     799#ifdef NC_DOUBLE
     800      ierr = nf_put_var_double(nid, id_fter, phy_glo)
     801#else
     802      ierr = nf_put_var_real(nid, id_fter, phy_glo)
     803#endif
    736804      IF (ierr/=nf_noerr) THEN
    737805        WRITE (*, *) 'writelim error with phy_fter'
    … …  
    742810    CALL gather(phy_foce, phy_glo)
    743811    IF (is_master) THEN
    744       ierr = nf90_put_var(nid, id_foce, phy_glo)
     812#ifdef NC_DOUBLE
     813      ierr = nf_put_var_double(nid, id_foce, phy_glo)
     814#else
     815      ierr = nf_put_var_real(nid, id_foce, phy_glo)
     816#endif
    745817      IF (ierr/=nf_noerr) THEN
    746818        WRITE (*, *) 'writelim error with phy_foce'
    … …  
    751823    CALL gather(phy_fsic, phy_glo)
    752824    IF (is_master) THEN
    753       ierr = nf90_put_var(nid, id_fsic, phy_glo)
     825#ifdef NC_DOUBLE
     826      ierr = nf_put_var_double(nid, id_fsic, phy_glo)
     827#else
     828      ierr = nf_put_var_real(nid, id_fsic, phy_glo)
     829#endif
    754830      IF (ierr/=nf_noerr) THEN
    755831        WRITE (*, *) 'writelim error with phy_fsic'
    … …  
    760836    CALL gather(phy_flic, phy_glo)
    761837    IF (is_master) THEN
    762       ierr = nf90_put_var(nid, id_flic, phy_glo)
     838#ifdef NC_DOUBLE
     839      ierr = nf_put_var_double(nid, id_flic, phy_glo)
     840#else
     841      ierr = nf_put_var_real(nid, id_flic, phy_glo)
     842#endif
    763843      IF (ierr/=nf_noerr) THEN
    764844        WRITE (*, *) 'writelim error with phy_flic'
    … …  
    9601040      END IF
    9611041
    962       if (type_profil==20) then
     1042      if (type_profil.EQ.20) then
    9631043      print*,'Profile SST 20'
    9641044!     Méthode 13 "Qmax2K" plateau réel �|  l'Equateur augmenté +2K
    … …  
    9691049      endif
    9701050
    971       if (type_profil==21) then
     1051      if (type_profil.EQ.21) then
    9721052      print*,'Profile SST 21'
    9731053!     Méthode 13 "Qmax2K" plateau réel �|  l'Equateur augmenté +2K

  • LMDZ6/trunk/libf/phylmdiso/phyetat0_mod.F90

    r5075 r5084  
    4848  USE time_phylmdz_mod, ONLY: init_iteration, pdtphys, itau_phy
    4949  USE wxios, ONLY: missing_val_xios => missing_val, using_xios
    50   use lmdz_netcdf, only: missing_val_netcdf => nf90_fill_real
     50  use netcdf, only: missing_val_netcdf => nf90_fill_real
    5151  use config_ocean_skin_m, only: activate_ocean_skin
    5252#ifdef ISO

  • LMDZ6/trunk/libf/phylmdiso/phys_local_var_mod.F90

    r5066 r5084  
    351351!$OMP THREADPRIVATE(d_deltat_vdf, d_deltaq_vdf)
    352352!!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: d_s_vdf, d_dens_vdf
    353 !!!$OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)
     353!!!OMP THREADPRIVATE(d_s_vdf, d_dens_vdf)
    354354    REAL, SAVE, ALLOCATABLE,DIMENSION(:,:)          :: d_deltat_the, d_deltaq_the
    355355!$OMP THREADPRIVATE(d_deltat_the, d_deltaq_the)
    356356!!!      REAL,ALLOCATABLE,SAVE,DIMENSION(:)          :: d_s_the, d_dens_the
    357 !!!$OMP THREADPRIVATE(d_s_the, d_dens_the)
     357!!!OMP THREADPRIVATE(d_s_the, d_dens_the)
    358358      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)           :: d_deltat_ajs_cv, d_deltaq_ajs_cv
    359359!$OMP THREADPRIVATE(d_deltat_ajs_cv, d_deltaq_ajs_cv)                       

  • LMDZ6/trunk/libf/phylmdiso/physiq_mod.F90

    r5075 r5084  
    4848    USE mod_phys_lmdz_para
    4949    USE netcdf95, only: nf95_close
    50     USE lmdz_netcdf, only: nf90_fill_real     ! IM for NMC files
     50    USE netcdf, only: nf90_fill_real     ! IM for NMC files
    5151    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
    5252    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
    … …  
    13551355    !lwoff=y : offset LW CRE for radiation code and other schemes
    13561356    REAL, SAVE :: betalwoff
    1357     !$OMP THREADPRIVATE(betalwoff)
     1357    !OMP THREADPRIVATE(betalwoff)
    13581358!
    13591359    INTEGER :: nbtr_tmp ! Number of tracer inside concvl

  • LMDZ6/trunk/tools/make_sso/make_sso_SpherePack.f90

    r5075 r5084  
    66! Purpose: Project ETOPO file (GMT4 axes conventions) on spherical harmonics.
    77!-------------------------------------------------------------------------------
    8   USE lmdz_netcdf, ONLY: nf90_noerr,nf90_strerror,nf90_close,nf90_put_var,nf90_enddef,&
    9           nf90_put_att,nf90_global,nf90_real,nf90_def_var,nf90_def_dim,nf90_inq_varid,&
    10           nf90_nowrite,nf90_inquire_dimension,nf90_inquire_variable,nf90_open
     8  USE netcdf
    119!  USE sphpack
    1210  IMPLICIT NONE

  • LMDZ6/trunk/tools/netcdf95/Attributes/nf95_copy_att.f90

    r5075 r5084  
    88  subroutine nf95_copy_att(ncid_in, varid_in, name, ncid_out, varid_out, ncerr)
    99
    10     use lmdz_netcdf, only: nf90_copy_att
     10    use netcdf, only: nf90_copy_att
    1111
    1212    use nf95_abort_m, only: nf95_abort

  • LMDZ6/trunk/tools/netcdf95/Attributes/nf95_get_att.f90

    r5075 r5084  
    22
    33  use nf95_abort_m, only: nf95_abort
    4   use lmdz_netcdf, only: nf90_get_att, nf90_noerr
     4  use netcdf, only: nf90_get_att, nf90_noerr
    55  use nf95_inquire_attribute_m, only: nf95_inquire_attribute
    66  use nf95_constants, only: nf95_noerr

  • LMDZ6/trunk/tools/netcdf95/Attributes/nf95_get_missing.F90

    r5075 r5084  
    11module nf95_get_missing_m
    22
    3   use lmdz_netcdf, only: nf90_noerr
     3  use netcdf, only: nf90_noerr
    44  use nf95_get_att_m, only: nf95_get_att
    55
    … …  
    1818  subroutine nf95_get_missing_real(ncid, varid, missing)
    1919
    20     use lmdz_netcdf, only: NF90_FILL_REAL
     20    use netcdf, only: NF90_FILL_REAL
    2121    use typesizes, only: FourByteReal
    2222
    … …  
    4444  subroutine nf95_get_missing_dble(ncid, varid, missing)
    4545
    46     use lmdz_netcdf, only: NF90_FILL_double
     46    use netcdf, only: NF90_FILL_double
    4747    use typesizes, only: EightByteReal
    4848
    … …  
    7070  subroutine nf95_get_missing_short_int(ncid, varid, missing)
    7171
    72     use lmdz_netcdf, only: NF90_FILL_short
     72    use netcdf, only: NF90_FILL_short
    7373    use typesizes, only: TwoByteInt
    7474
    … …  
    9696  subroutine nf95_get_missing_int(ncid, varid, missing)
    9797
    98     use lmdz_netcdf, only: NF90_FILL_INT
     98    use netcdf, only: NF90_FILL_INT
    9999
    100100    integer, intent(in)::  ncid, varid
    … …  
    121121  subroutine nf95_get_missing_char(ncid, varid, missing)
    122122
    123     use lmdz_netcdf, only: NF90_FILL_char
     123    use netcdf, only: NF90_FILL_char
    124124
    125125    integer, intent(in)::  ncid, varid

  • LMDZ6/trunk/tools/netcdf95/Attributes/nf95_inquire_attribute.f90

    r5075 r5084  
    1010
    1111    use nf95_abort_m, only: nf95_abort
    12     use lmdz_netcdf, only: nf90_inquire_attribute
     12    use netcdf, only: nf90_inquire_attribute
    1313    use nf95_constants, only: nf95_noerr
    1414

  • LMDZ6/trunk/tools/netcdf95/Attributes/nf95_put_att.f90

    r5075 r5084  
    11module nf95_put_att_m
    22
    3   use lmdz_netcdf, only: nf90_put_att
     3  use netcdf, only: nf90_put_att
    44  use nf95_abort_m, only: nf95_abort
    55  use nf95_constants, only: nf95_noerr

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_close.f90

    r5075 r5084  
    1010    ! call it.
    1111
    12     use lmdz_netcdf, only: nf90_close, nf90_strerror
     12    use netcdf, only: nf90_close, nf90_strerror
    1313
    1414    use nf95_constants, only: nf95_noerr

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_create.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_create
     10    use netcdf, only: nf90_create
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_create_single.f90

    r5075 r5084  
    11module nf95_create_single_m
    22
    3   use lmdz_netcdf, only: NF90_MAX_NAME
     3  use netcdf, only: NF90_MAX_NAME
    44
    55  implicit none
    … …  
    1919    ! Shortcut to create a file containing a single primary variable.
    2020
    21     use lmdz_netcdf, only: NF90_CLOBBER, NF90_FLOAT
     21    use netcdf, only: NF90_CLOBBER, NF90_FLOAT
    2222
    2323    use nf95_create_m, only: nf95_create

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_enddef.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_enddef
     10    use netcdf, only: nf90_enddef
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_find_coord.f90

    r5075 r5084  
    1515    ! attribute "std_name".
    1616
    17     use lmdz_netcdf, only: NF90_MAX_NAME, NF90_NOERR
     17    use netcdf, only: NF90_MAX_NAME, NF90_NOERR
    1818    use nf95_get_att_m, only: nf95_get_att
    1919    use nf95_inq_varid_m, only: nf95_inq_varid

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_inquire.f90

    r5075 r5084  
    1010   
    1111    use nf95_abort_m, only: nf95_abort
    12     use lmdz_netcdf, only: nf90_inquire
     12    use netcdf, only: nf90_inquire
    1313    use nf95_constants, only: nf95_noerr
    1414

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_open.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_open
     10    use netcdf, only: nf90_open
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_redef.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_redef
     10    use netcdf, only: nf90_redef
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Datasets/nf95_sync.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_sync
     10    use netcdf, only: nf90_sync
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Groups/nf95_inq_file_ncid.f90

    r5075 r5084  
    1111    ! by nf95_abort, so it cannot call it.
    1212
    13     use lmdz_netcdf, only: nf90_strerror
     13    use netcdf, only: nf90_strerror
    1414
    1515    use nf95_constants, only: Nf95_ENOGRP, nf95_noerr

  • LMDZ6/trunk/tools/netcdf95/Groups/nf95_inq_grp_parent.f90

    r5075 r5084  
    1212    use, intrinsic:: ISO_C_BINDING
    1313
    14     use lmdz_netcdf, only: nf90_strerror
     14    use netcdf, only: nf90_strerror
    1515
    1616    use nc_constants, only: NC_NOERR

  • LMDZ6/trunk/tools/netcdf95/Groups/nf95_inq_grps.f90

    r5075 r5084  
    2626    use, intrinsic:: ISO_C_BINDING
    2727
    28     use lmdz_netcdf, only: nf90_noerr
     28    use netcdf, only: nf90_noerr
    2929
    3030    use nc_constants, only: nc_noerr

  • LMDZ6/trunk/tools/netcdf95/Variables/check_start_count.f90

    r5075 r5084  
    1919    use nf95_close_m, only: nf95_close
    2020    use nf95_inquire_variable_m, only: nf95_inquire_variable
    21     use lmdz_netcdf, only: nf90_noerr
     21    use netcdf, only: nf90_noerr
    2222
    2323    character(len=*), intent(in):: name_calling ! name of calling procedure

  • LMDZ6/trunk/tools/netcdf95/Variables/nf95_def_var.f90

    r5075 r5084  
    77  ! "nf95_def_var_scalar" cannot be distinguished from "nf95_def_var_oneDim".
    88
    9   use lmdz_netcdf, only: nf90_def_var
     9  use netcdf, only: nf90_def_var
    1010  use nf95_abort_m, only: nf95_abort
    1111  use nf95_constants, only: nf95_noerr

  • LMDZ6/trunk/tools/netcdf95/Variables/nf95_get_var.f90

    r5075 r5084  
    11module nf95_get_var_m
    22
    3   use lmdz_netcdf, only: nf90_get_var, NF90_NOERR
     3  use netcdf, only: nf90_get_var, NF90_NOERR
    44 
    55  use nf95_abort_m, only: nf95_abort

  • LMDZ6/trunk/tools/netcdf95/Variables/nf95_inq_varid.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_inq_varid
     10    use netcdf, only: nf90_inq_varid
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/Variables/nf95_inquire_variable.f90

    r5075 r5084  
    1616
    1717    use nf95_abort_m, only: nf95_abort
    18     use lmdz_netcdf, only: nf90_inquire_variable, nf90_max_var_dims
     18    use netcdf, only: nf90_inquire_variable, nf90_max_var_dims
    1919    use nf95_constants, only: nf95_noerr
    2020

  • LMDZ6/trunk/tools/netcdf95/Variables/nf95_put_var.f90

    r5075 r5084  
    11module nf95_put_var_m
    22
    3   use lmdz_netcdf, only: nf90_put_var
     3  use netcdf, only: nf90_put_var
    44  use nf95_abort_m, only: nf95_abort
    55  use check_start_count_m, only: check_start_count

  • LMDZ6/trunk/tools/netcdf95/nf95_abort.f90

    r5075 r5084  
    1010
    1111    ! Libraries:
    12     use lmdz_netcdf, only: nf90_strerror
     12    use netcdf, only: nf90_strerror
    1313
    1414    use nf95_close_m, only: nf95_close

  • LMDZ6/trunk/tools/netcdf95/nf95_def_dim.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_def_dim
     10    use netcdf, only: nf90_def_dim
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/nf95_inq_dimid.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_inq_dimid
     10    use netcdf, only: nf90_inq_dimid
    1111    use nf95_constants, only: nf95_noerr
    1212

  • LMDZ6/trunk/tools/netcdf95/nf95_inquire_dimension.f90

    r5075 r5084  
    88
    99    use nf95_abort_m, only: nf95_abort
    10     use lmdz_netcdf, only: nf90_inquire_dimension
     10    use netcdf, only: nf90_inquire_dimension
    1111    use nf95_constants, only: nf95_noerr
    1212
Note: See TracChangeset for help on using the changeset viewer.