Ignore:
Timestamp:
Jul 18, 2024, 2:27:04 PM (18 months 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/dyn3dmem
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • 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
Note: See TracChangeset for help on using the changeset viewer.