Changeset 5069
- Timestamp:
- Jul 18, 2024, 2:27:04 PM (7 weeks ago)
- Location:
- LMDZ6/trunk/libf
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3d/dynredem_mod.F90
r5068 r5069 1 1 MODULE dynredem_mod 2 2 3 USE netcdf4 PRIVATE3 USE lmdz_netcdf 4 IMPLICIT NONE; PRIVATE 5 5 PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err 6 6 PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg … … 18 18 SUBROUTINE dynredem_write_u(ncid,id,var,ll) 19 19 ! 20 !===============================================================================21 IMPLICIT NONE22 20 !=============================================================================== 23 21 ! Arguments: … … 44 42 ! 45 43 !=============================================================================== 46 IMPLICIT NONE47 !===============================================================================48 44 ! Arguments: 49 45 INTEGER, INTENT(IN) :: ncid … … 68 64 SUBROUTINE dynredem_read_u(ncid,id,var,ll) 69 65 ! 70 !===============================================================================71 IMPLICIT NONE72 66 !=============================================================================== 73 67 ! Arguments: … … 94 88 ! 95 89 !=============================================================================== 96 USE lmdz_netcdf, ONLY: NF90_FORMAT97 IMPLICIT NONE98 !===============================================================================99 90 ! Arguments: 100 91 INTEGER, INTENT(IN) :: ncid … … 116 107 SUBROUTINE put_var1(ncid,var,title,did,v,units) 117 108 ! 118 !===============================================================================119 IMPLICIT NONE120 109 !=============================================================================== 121 110 ! Arguments: … … 142 131 ! 143 132 !=============================================================================== 144 IMPLICIT NONE145 !===============================================================================146 133 ! Arguments: 147 134 INTEGER, INTENT(IN) :: ncid … … 166 153 FUNCTION msg(typ,nam) 167 154 ! 168 !===============================================================================169 IMPLICIT NONE170 155 !=============================================================================== 171 156 ! Arguments: … … 194 179 ! 195 180 !=============================================================================== 196 IMPLICIT NONE197 !===============================================================================198 181 ! Arguments: 199 182 INTEGER, INTENT(IN) :: ierr !--- NetCDF ERROR CODE -
LMDZ6/trunk/libf/dyn3dmem/dynredem_mod.F90
r5060 r5069 4 4 USE parallel_lmdz 5 5 USE mod_hallo 6 USE netcdf6 USE lmdz_netcdf 7 7 PRIVATE 8 8 PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err … … 180 180 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 181 181 !=============================================================================== 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) 187 183 IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) 188 184 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 !4 1 MODULE guide_loc_mod 5 2 … … 11 8 USE getparam, only: ini_getparam, fin_getparam, getpar 12 9 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 15 15 USE parallel_lmdz 16 16 USE pres2lev_mod, only: pres2lev … … 81 81 INCLUDE "dimensions.h" 82 82 INCLUDE "paramet.h" 83 INCLUDE "netcdf.inc"84 83 85 84 INTEGER :: error,ncidpl,rid,rcod … … 1576 1575 IMPLICIT NONE 1577 1576 1578 include "netcdf.inc"1579 1577 include "dimensions.h" 1580 1578 include "paramet.h" … … 1788 1786 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1789 1787 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) 1797 1790 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) 1803 1792 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous 1804 1793 IF(convert_Pa) apnc=apnc*100.! conversion en Pascals … … 1826 1815 ! Pression 1827 1816 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) 1833 1818 IF (invert_y) THEN 1834 1819 ! PRINT*,"Invertion impossible actuellement" … … 1840 1825 ! Vent zonal 1841 1826 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) 1847 1828 IF (invert_y) THEN 1848 1829 ! PRINT*,"Invertion impossible actuellement" … … 1856 1837 ! Temperature 1857 1838 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) 1863 1840 IF (invert_y) THEN 1864 1841 ! PRINT*,"Invertion impossible actuellement" … … 1870 1847 ! Humidite 1871 1848 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) 1877 1850 IF (invert_y) THEN 1878 1851 ! PRINT*,"Invertion impossible actuellement" … … 1889 1862 IF (invert_y) start(2)=jjm-jje_v+1 1890 1863 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) 1896 1865 IF (invert_y) THEN 1897 1866 ! PRINT*,"Invertion impossible actuellement" … … 1910 1879 count(4)=0 1911 1880 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) 1917 1882 IF (invert_y) THEN 1918 1883 ! PRINT*,"Invertion impossible actuellement" … … 1929 1894 IMPLICIT NONE 1930 1895 1931 include "netcdf.inc"1932 1896 include "dimensions.h" 1933 1897 include "paramet.h" … … 2075 2039 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 2076 2040 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) 2084 2043 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) 2090 2045 apnc=apnc*100.! conversion en Pascals 2091 2046 bpnc(:)=0. … … 2112 2067 ! Pression 2113 2068 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) 2119 2070 DO i=1,iip1 2120 2071 pnat2(i,:,:)=zu(:,:) … … 2129 2080 ! Vent zonal 2130 2081 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) 2136 2083 DO i=1,iip1 2137 2084 unat2(i,:,:)=zu(:,:) … … 2148 2095 ! Temperature 2149 2096 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) 2155 2098 DO i=1,iip1 2156 2099 tnat2(i,:,:)=zu(:,:) … … 2166 2109 ! Humidite 2167 2110 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) 2173 2112 DO i=1,iip1 2174 2113 qnat2(i,:,:)=zu(:,:) … … 2187 2126 count(2)=jjnb_v 2188 2127 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) 2194 2129 DO i=1,iip1 2195 2130 vnat2(i,:,:)=zv(:,:) … … 2213 2148 count(4)=0 2214 2149 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)) 2220 2151 DO i=1,iip1 2221 2152 psnat2(i,:)=zu(:,1) … … 2238 2169 USE comvert_mod, ONLY: presnivs 2239 2170 use netcdf95, only: nf95_def_var, nf95_put_var 2240 use netcdf, only: nf90_float2241 2171 2242 2172 IMPLICIT NONE … … 2244 2174 INCLUDE "dimensions.h" 2245 2175 INCLUDE "paramet.h" 2246 INCLUDE "netcdf.inc"2247 2176 INCLUDE "comgeom2.h" 2248 2177 … … 2328 2257 2329 2258 ! 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) 2351 2268 call nf95_put_var(nid, varid_alpha_t, zt) 2352 2269 call nf95_put_var(nid, varid_alpha_q, zq) … … 2438 2355 !$OMP MASTER 2439 2356 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) 2446 2358 ierr = NF_CLOSE(nid) 2447 2359 -
LMDZ6/trunk/libf/misc/lmdz_netcdf.F90
r5068 r5069 3 3 ! It serves two primary functions: 4 4 ! 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 6 7 ! --------------------------------------------- 8 ! TODO check that none of the wrapped functions remain elsewhere 9 ! TODO check all uses of `use netcdf` + netcdf.inc 7 10 8 11 MODULE lmdz_netcdf … … 12 15 ! Note: as we want to expose netcdf through this module, we don't make all PRIVATE by default as usual 13 16 ! Instead, explicitely make PRIVATE the relevant items. 17 PRIVATE CPP_NC_DOUBLE 14 18 15 19 INCLUDE 'netcdf.inc' 16 20 17 21 #ifdef NC_DOUBLE 22 LOGICAL, PARAMETER :: CPP_NC_DOUBLE = .TRUE. ! Define a variable to reduce use of preprocessor ahead 18 23 INTEGER, PARAMETER :: NF90_FORMAT = NF90_DOUBLE 19 24 INTEGER, PARAMETER :: REAL_FORMAT = REAL64 20 25 #else 26 LOGICAL, PARAMETER :: CPP_NC_DOUBLE = .FALSE. 21 27 INTEGER, PARAMETER :: NF90_FORMAT = NF90_FLOAT 22 28 INTEGER, PARAMETER :: REAL_FORMAT = REAL32 … … 24 30 CONTAINS 25 31 32 ! Note: below, we use the same declarations as the fortran netcdf lib, hence the use of (*) 33 26 34 ! 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 27 36 INTEGER FUNCTION nf_put_var_rd(ncid, varid, vals) 28 37 INTEGER, INTENT(IN) :: ncid, varid 29 38 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 35 45 END FUNCTION nf_put_var_rd 36 46 47 ! CPP_NC_DOUBLE wrapper around nf_put_vara_real, nf_put_vara_double 37 48 INTEGER FUNCTION nf_put_vara_rd(ncid, varid, start, counts, vals) 38 49 INTEGER, INTENT(IN) :: ncid, varid 39 50 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 46 58 END FUNCTION nf_put_vara_rd 47 59 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 48 73 END MODULE lmdz_netcdf 49 50 ! TODO check that none of the wrapped functions remain elsewhere51 ! TODO check all uses of `use netcdf`
Note: See TracChangeset
for help on using the changeset viewer.