Changeset 5069


Ignore:
Timestamp:
Jul 18, 2024, 2:27:04 PM (7 weeks ago)
Author:
abarral
Message:

Reduce use of #ifdef NC_DOUBLE to single instance in lmdz_netcdf.F90
Add nf_get_vara_rd in lmdz_netcdf.F90
Remove #ifdef NC_DOUBLE in dynredem_mod.F90 & guide_loc_mod.F90
(minor) fix some casting in ncdf calls in guide_loc_mod.F90
(minor) replace netcdf call & reduncate implicit none in dynredem_mod.F90

Location:
LMDZ6/trunk/libf
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r5068 r5069  
    11MODULE dynredem_mod
    22
    3   USE netcdf
    4   PRIVATE
     3  USE lmdz_netcdf
     4  IMPLICIT NONE; PRIVATE
    55  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
    66  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
    … …  
    1818SUBROUTINE dynredem_write_u(ncid,id,var,ll)
    1919!
    20 !===============================================================================
    21   IMPLICIT NONE
    2220!===============================================================================
    2321! Arguments:
    … …  
    4442!
    4543!===============================================================================
    46   IMPLICIT NONE
    47 !===============================================================================
    4844! Arguments:
    4945  INTEGER,          INTENT(IN) :: ncid
    … …  
    6864SUBROUTINE dynredem_read_u(ncid,id,var,ll)
    6965!
    70 !===============================================================================
    71   IMPLICIT NONE
    7266!===============================================================================
    7367! Arguments:
    … …  
    9488!
    9589!===============================================================================
    96   USE lmdz_netcdf, ONLY: NF90_FORMAT
    97   IMPLICIT NONE
    98 !===============================================================================
    9990! Arguments:
    10091  INTEGER,                    INTENT(IN) :: ncid
    … …  
    116107SUBROUTINE put_var1(ncid,var,title,did,v,units)
    117108!
    118 !===============================================================================
    119   IMPLICIT NONE
    120109!===============================================================================
    121110! Arguments:
    … …  
    142131!
    143132!===============================================================================
    144   IMPLICIT NONE
    145 !===============================================================================
    146133! Arguments:
    147134  INTEGER,                    INTENT(IN) :: ncid
    … …  
    166153FUNCTION msg(typ,nam)
    167154!
    168 !===============================================================================
    169   IMPLICIT NONE
    170155!===============================================================================
    171156! Arguments:
    … …  
    194179!
    195180!===============================================================================
    196   IMPLICIT NONE
    197 !===============================================================================
    198181! Arguments:
    199182  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE

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

    r5060 r5069  
    44  USE parallel_lmdz
    55  USE mod_hallo
    6   USE netcdf
     6  USE lmdz_netcdf
    77  PRIVATE
    88  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
    … …  
    180180  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
    181181!===============================================================================
    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
     182  CALL err(NF90_DEF_VAR(ncid,var,NF90_FORMAT,did,nvarid),"inq",var)
    187183  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
    188184  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)

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

    r4469 r5069  
    1 !
    2 ! $Id$
    3 !
    41MODULE guide_loc_mod
    52
    … …  
    118  USE getparam, only: ini_getparam, fin_getparam, getpar
    129  USE Write_Field_loc
    13   use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
    14                     nf90_inq_dimid, nf90_inquire_dimension
     10  use lmdz_netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &
     11          nf90_inq_dimid, nf90_inquire_dimension, nf_get_vara_rd, nf_inq_dimid, &
     12          nf_inq_dimlen, nf_enddef, nf_def_dim, nf_put_var_rd, 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, nf_put_vara_rd
    1515  USE parallel_lmdz
    1616  USE pres2lev_mod, only: pres2lev
    … …  
    8181    INCLUDE "dimensions.h"
    8282    INCLUDE "paramet.h"
    83     INCLUDE "netcdf.inc"
    8483
    8584    INTEGER                :: error,ncidpl,rid,rcod
    … …  
    15761575    IMPLICIT NONE
    15771576
    1578     include "netcdf.inc"
    15791577    include "dimensions.h"
    15801578    include "paramet.h"
    … …  
    17881786! Coefs ap, bp pour calcul de la pression aux differents niveaux
    17891787         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
     1788             status=nf_get_vara_rd(ncidpl,varidap,[1],[nlevnc],apnc)
     1789             status=nf_get_vara_rd(ncidpl,varidbp,[1],[nlevnc],bpnc)
    17971790         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
     1791             status=nf_get_vara_rd(ncidpl,varidpl,[1],[nlevnc],apnc)
    18031792!FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous
    18041793             IF(convert_Pa) apnc=apnc*100.! conversion en Pascals
    … …  
    18261815! Pression
    18271816     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
     1817         status=nf_get_vara_rd(ncidp,varidp,start,count,pnat2)
    18331818         IF (invert_y) THEN
    18341819!           PRINT*,"Invertion impossible actuellement"
    … …  
    18401825!  Vent zonal
    18411826     if (guide_u) then
    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
     1827         status=nf_get_vara_rd(ncidu,varidu,start,count,unat2)
    18471828         IF (invert_y) THEN
    18481829!           PRINT*,"Invertion impossible actuellement"
    … …  
    18561837!  Temperature
    18571838     if (guide_T) then
    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
     1839         status=nf_get_vara_rd(ncidt,varidt,start,count,tnat2)
    18631840         IF (invert_y) THEN
    18641841!           PRINT*,"Invertion impossible actuellement"
    … …  
    18701847!  Humidite
    18711848     if (guide_Q) then
    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
     1849         status=nf_get_vara_rd(ncidQ,varidQ,start,count,qnat2)
    18771850         IF (invert_y) THEN
    18781851!           PRINT*,"Invertion impossible actuellement"
    … …  
    18891862         IF (invert_y) start(2)=jjm-jje_v+1
    18901863
    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
     1864         status=nf_get_vara_rd(ncidv,varidv,start,count,vnat2)
    18961865         IF (invert_y) THEN
    18971866!           PRINT*,"Invertion impossible actuellement"
    … …  
    19101879         count(4)=0
    19111880         IF (invert_y) start(2)=jjp1-jje_u+1
    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
     1881         status=nf_get_vara_rd(ncidps,varidps,start,count,psnat2)
    19171882         IF (invert_y) THEN
    19181883!           PRINT*,"Invertion impossible actuellement"
    … …  
    19291894    IMPLICIT NONE
    19301895
    1931     include "netcdf.inc"
    19321896    include "dimensions.h"
    19331897    include "paramet.h"
    … …  
    20752039! Coefs ap, bp pour calcul de la pression aux differents niveaux
    20762040         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
     2041             status=nf_get_vara_rd(ncidpl,varidap,[1],[nlevnc],apnc)
     2042             status=nf_get_vara_rd(ncidpl,varidbp,[1],[nlevnc],bpnc)
    20842043         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
     2044             status=nf_get_vara_rd(ncidpl,varidpl,[1],[nlevnc],apnc)
    20902045             apnc=apnc*100.! conversion en Pascals
    20912046             bpnc(:)=0.
    … …  
    21122067!  Pression
    21132068     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
     2069         status=nf_get_vara_rd(ncidp,varidp,start,count,zu)
    21192070         DO i=1,iip1
    21202071             pnat2(i,:,:)=zu(:,:)
    … …  
    21292080!  Vent zonal
    21302081     if (guide_u) then
    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
     2082         status=nf_get_vara_rd(ncidu,varidu,start,count,zu)
    21362083         DO i=1,iip1
    21372084             unat2(i,:,:)=zu(:,:)
    … …  
    21482095!  Temperature
    21492096     if (guide_T) then
    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
     2097         status=nf_get_vara_rd(ncidt,varidt,start,count,zu)
    21552098         DO i=1,iip1
    21562099             tnat2(i,:,:)=zu(:,:)
    … …  
    21662109!  Humidite
    21672110     if (guide_Q) then
    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
     2111         status=nf_get_vara_rd(ncidQ,varidQ,start,count,zu)
    21732112         DO i=1,iip1
    21742113             qnat2(i,:,:)=zu(:,:)
    … …  
    21872126         count(2)=jjnb_v
    21882127         IF (invert_y) start(2)=jjm-jje_v+1
    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
     2128         status=nf_get_vara_rd(ncidv,varidv,start,count,zv)
    21942129         DO i=1,iip1
    21952130             vnat2(i,:,:)=zv(:,:)
    … …  
    22132148         count(4)=0
    22142149         IF (invert_y) start(2)=jjp1-jje_u+1
    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
     2150         status=nf_get_vara_rd(ncidps,varidps,start,count,zu(:,1))
    22202151         DO i=1,iip1
    22212152             psnat2(i,:)=zu(:,1)
    … …  
    22382169    USE comvert_mod, ONLY: presnivs
    22392170    use netcdf95, only: nf95_def_var, nf95_put_var
    2240     use netcdf, only: nf90_float
    22412171
    22422172    IMPLICIT NONE
    … …  
    22442174    INCLUDE "dimensions.h"
    22452175    INCLUDE "paramet.h"
    2246     INCLUDE "netcdf.inc"
    22472176    INCLUDE "comgeom2.h"
    22482177   
    … …  
    23282257
    23292258! Enregistrement des variables dimensions
    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
     2259        ierr = nf_put_var_rd(nid,vid_lonu,rlonu*180./pi)
     2260        ierr = nf_put_var_rd(nid,vid_lonv,rlonv*180./pi)
     2261        ierr = nf_put_var_rd(nid,vid_latu,rlatu*180./pi)
     2262        ierr = nf_put_var_rd(nid,vid_latv,rlatv*180./pi)
     2263        ierr = nf_put_var_rd(nid,vid_lev,presnivs)
     2264        ierr = nf_put_var_rd(nid,vid_cu,cu)
     2265        ierr = nf_put_var_rd(nid,vid_cv,cv)
     2266        ierr = nf_put_var_rd(nid,vid_au,zu)
     2267        ierr = nf_put_var_rd(nid,vid_av,zv)
    23512268        call nf95_put_var(nid, varid_alpha_t, zt)
    23522269        call nf95_put_var(nid, varid_alpha_q, zq)
    … …  
    24382355!$OMP MASTER
    24392356
    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 
     2357    ierr = nf_put_vara_rd(nid,varid,start,count,field_glo)
    24462358    ierr = NF_CLOSE(nid)
    24472359

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

    r5068 r5069  
    33! It serves two primary functions:
    44!  1) Turn netcdf into a "real" fortran module, without the INCLUDE call
    5 !  2) Handle the NC_DOUBLE CPP key
     5!  2) Handle the NC_DOUBLE CPP key. Ideally, this key should ONLY appear here (WIP). TODO
     6! Ideally, the "real" netcdf module/headers should ONLY be called here. (WIP) TODO
    67! ---------------------------------------------
     8! TODO check that none of the wrapped functions remain elsewhere
     9! TODO check all uses of `use netcdf` + netcdf.inc
    710
    811MODULE lmdz_netcdf
    … …  
    1215  ! Note: as we want to expose netcdf through this module, we don't make all PRIVATE by default as usual
    1316  ! Instead, explicitely make PRIVATE the relevant items.
     17  PRIVATE CPP_NC_DOUBLE
    1418
    1519  INCLUDE 'netcdf.inc'
    1620
    1721#ifdef NC_DOUBLE
     22  LOGICAL, PARAMETER :: CPP_NC_DOUBLE = .TRUE.  ! Define a variable to reduce use of preprocessor ahead
    1823  INTEGER, PARAMETER :: NF90_FORMAT = NF90_DOUBLE
    1924  INTEGER, PARAMETER :: REAL_FORMAT = REAL64
    2025#else
     26  LOGICAL, PARAMETER :: CPP_NC_DOUBLE = .FALSE.
    2127  INTEGER, PARAMETER :: NF90_FORMAT = NF90_FLOAT
    2228  INTEGER, PARAMETER :: REAL_FORMAT = REAL32
    … …  
    2430CONTAINS
    2531
     32  ! Note: below, we use the same declarations as the fortran netcdf lib, hence the use of (*)
     33
    2634  ! We'd like to use "nf_put_var", but it already exists as a legacy nc4 function
     35  ! CPP_NC_DOUBLE wrapper around nf_put_var_real, nf_put_var_double
    2736  INTEGER FUNCTION nf_put_var_rd(ncid, varid, vals)
    2837    INTEGER, INTENT(IN) :: ncid, varid
    2938    REAl(REAL_FORMAT), INTENT(IN) :: vals(*)  ! (*) as declared in netcdf lib
    30 #ifdef NC_DOUBLE
    31     nf_put_var_rd = nf_put_var_double(ncid, varid, vals)
    32 #else
    33     nf_put_var_rd = nf_put_var_real(ncid, varid, vals)
    34 #endif
     39
     40    IF (CPP_NC_DOUBLE) THEN
     41      nf_put_var_rd = nf_put_var_double(ncid, varid, vals)
     42    ELSE
     43      nf_put_var_rd = nf_put_var_real(ncid, varid, vals)
     44    END IF
    3545  END FUNCTION nf_put_var_rd
    3646
     47  ! CPP_NC_DOUBLE wrapper around nf_put_vara_real, nf_put_vara_double
    3748  INTEGER FUNCTION nf_put_vara_rd(ncid, varid, start, counts, vals)
    3849    INTEGER, INTENT(IN) :: ncid, varid
    3950    INTEGER, INTENT(IN) :: start(*), counts(*)
    40     REAl(REAL_FORMAT), INTENT(IN) :: vals(*)  ! (*) as declared in netcdf lib
    41 #ifdef NC_DOUBLE
    42     nf_put_vara_rd = nf_put_vara_double(ncid, varid, vals)
    43 #else
    44     nf_put_vara_rd = nf_put_vara_real(ncid, varid, vals)
    45 #endif
     51    REAl(REAL_FORMAT), INTENT(IN) :: vals(*)
     52
     53    IF (CPP_NC_DOUBLE) THEN
     54      nf_put_vara_rd = nf_put_vara_double(ncid, varid, start, counts, vals)
     55    ELSE
     56      nf_put_vara_rd = nf_put_vara_real(ncid, varid, start, counts, vals)
     57    END IF
    4658  END FUNCTION nf_put_vara_rd
    4759
     60  ! CPP_NC_DOUBLE wrapper around nf_get_vara_real, nf_get_vara_double
     61  INTEGER FUNCTION nf_get_vara_rd(ncid, varid, start, counts, vals)
     62    INTEGER, INTENT(IN) :: ncid, varid
     63    INTEGER, INTENT(IN) :: start(*), counts(*)
     64    REAl(REAL_FORMAT), INTENT(OUT) :: vals(*)
     65
     66    IF (CPP_NC_DOUBLE) THEN
     67      nf_get_vara_rd = nf_get_vara_double(ncid, varid, start, counts, vals)
     68    ELSE
     69      nf_get_vara_rd = nf_get_vara_real(ncid, varid, start, counts, vals)
     70    END IF
     71  END FUNCTION nf_get_vara_rd
     72
    4873END MODULE lmdz_netcdf
    49 
    50 ! TODO check that none of the wrapped functions remain elsewhere
    51 ! TODO check all uses of `use netcdf`
Note: See TracChangeset for help on using the changeset viewer.