Changeset 5084 for LMDZ6/trunk/libf/dyn3dmem
- Timestamp:
- Jul 19, 2024, 6:40:44 PM (6 months ago)
- Location:
- LMDZ6/trunk/libf/dyn3dmem
- Files:
-
- 1 deleted
- 7 edited
- 1 copied
-
call_calfis_mod.F90 (copied) (copied from LMDZ6/trunk/libf/dyn3dmem/call_calfis_mod.F90)
-
dynetat0_loc.F90 (modified) (1 diff)
-
dynredem_loc.F90 (modified) (2 diffs)
-
dynredem_mod.F90 (modified) (2 diffs)
-
guide_loc_mod.F90 (modified) (76 diffs)
-
iniacademic_loc.F90 (modified) (3 diffs)
-
leapfrog_loc.F (modified) (1 diff)
-
leapfrog_mod.F90 (modified) (1 diff)
-
lmdz_call_calfis.F90 (deleted)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90
r5075 r5084 9 9 USE infotrac, ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName 10 10 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, & 12 12 NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE, NF90_NoErr 13 13 USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey -
LMDZ6/trunk/libf/dyn3dmem/dynredem_loc.F90
r5075 r5084 11 11 USE strings_mod, ONLY: maxlen 12 12 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, & 14 14 NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER, & 15 15 NF90_64BIT_OFFSET … … 178 178 USE infotrac, ONLY: nqtot, tracers, type_trac 179 179 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, & 181 181 NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, NF90_NoErr 182 182 USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, & -
LMDZ6/trunk/libf/dyn3dmem/dynredem_mod.F90
r5075 r5084 4 4 USE parallel_lmdz 5 5 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 8 7 PRIVATE 9 8 PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err … … 181 180 CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units 182 181 !=============================================================================== 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 184 187 IF(title/="") CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var) 185 188 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 ! 1 4 MODULE guide_loc_mod 2 5 … … 8 11 USE getparam, only: ini_getparam, fin_getparam, getpar 9 12 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 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" 83 84 84 85 INTEGER :: error,ncidpl,rid,rcod … … 125 126 CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage') 126 127 ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois. 127 IF (iguide_sav >0) THEN128 IF (iguide_sav.GT.0) THEN 128 129 iguide_sav=day_step/iguide_sav 129 130 ELSE if (iguide_sav == 0) then … … 145 146 CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage') 146 147 CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert') 147 IF (iguide_int ==0) THEN148 IF (iguide_int.EQ.0) THEN 148 149 iguide_int=1 149 ELSEIF (iguide_int >0) THEN150 ELSEIF (iguide_int.GT.0) THEN 150 151 iguide_int=day_step/iguide_int 151 152 ELSE … … 173 174 ! --------------------------------------------- 174 175 ncidpl=-99 175 if (guide_plevs ==1) then176 if (ncidpl ==-99) then176 if (guide_plevs.EQ.1) then 177 if (ncidpl.eq.-99) then 177 178 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 178 if (rcod /=NF_NOERR) THEN179 if (rcod.NE.NF_NOERR) THEN 179 180 abort_message=' Nudging error -> no file apbp.nc' 180 181 CALL abort_gcm(modname,abort_message,1) 181 182 endif 182 183 endif 183 elseif (guide_plevs ==2) then184 if (ncidpl ==-99) then184 elseif (guide_plevs.EQ.2) then 185 if (ncidpl.EQ.-99) then 185 186 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 186 if (rcod /=NF_NOERR) THEN187 if (rcod.NE.NF_NOERR) THEN 187 188 abort_message=' Nudging error -> no file P.nc' 188 189 CALL abort_gcm(modname,abort_message,1) … … 191 192 192 193 elseif (guide_u) then 193 if (ncidpl ==-99) then194 if (ncidpl.eq.-99) then 194 195 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 195 if (rcod /=NF_NOERR) THEN196 if (rcod.NE.NF_NOERR) THEN 196 197 abort_message=' Nudging error -> no file u.nc' 197 198 CALL abort_gcm(modname,abort_message,1) … … 202 203 203 204 elseif (guide_v) then 204 if (ncidpl ==-99) then205 if (ncidpl.eq.-99) then 205 206 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 206 if (rcod /=NF_NOERR) THEN207 if (rcod.NE.NF_NOERR) THEN 207 208 abort_message=' Nudging error -> no file v.nc' 208 209 CALL abort_gcm(modname,abort_message,1) … … 212 213 213 214 elseif (guide_T) then 214 if (ncidpl ==-99) then215 if (ncidpl.eq.-99) then 215 216 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 216 if (rcod /=NF_NOERR) THEN217 if (rcod.NE.NF_NOERR) THEN 217 218 abort_message=' Nudging error -> no file T.nc' 218 219 CALL abort_gcm(modname,abort_message,1) … … 223 224 224 225 elseif (guide_Q) then 225 if (ncidpl ==-99) then226 if (ncidpl.eq.-99) then 226 227 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 227 if (rcod /=NF_NOERR) THEN228 if (rcod.NE.NF_NOERR) THEN 228 229 abort_message=' Nudging error -> no file hur.nc' 229 230 CALL abort_gcm(modname,abort_message,1) … … 234 235 endif 235 236 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 236 IF (error /=NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)237 IF (error /=NF_NOERR) THEN237 IF (error.NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 238 IF (error.NE.NF_NOERR) THEN 238 239 abort_message='Nudging: error reading pressure levels' 239 240 CALL abort_gcm(modname,abort_message,1) … … 316 317 ENDIF 317 318 318 IF (guide_plevs ==2) THEN319 IF (guide_plevs.EQ.2) THEN 319 320 ALLOCATE(pnat1(iip1,jjb_u:jje_u,nlevnc), stat = error) 320 321 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 324 325 ENDIF 325 326 326 IF (guide_P.OR.guide_plevs ==1) THEN327 IF (guide_P.OR.guide_plevs.EQ.1) THEN 327 328 ALLOCATE(psnat1(iip1,jjb_u:jje_u), stat = error) 328 329 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 351 352 IF (guide_T) tnat1=tnat2 352 353 IF (guide_Q) qnat1=qnat2 353 IF (guide_plevs ==2) pnat1=pnat2354 IF (guide_P.OR.guide_plevs ==1) psnat1=psnat2354 IF (guide_plevs.EQ.2) pnat1=pnat2 355 IF (guide_P.OR.guide_plevs.EQ.1) psnat1=psnat2 355 356 356 357 END SUBROUTINE guide_init … … 488 489 ! Lecture des fichiers de guidage ? 489 490 !----------------------------------------------------------------------- 490 IF (iguide_read /=0) THEN491 IF (iguide_read.NE.0) THEN 491 492 ditau=real(itau) 492 493 dday_step=real(day_step) 493 IF (iguide_read <0) THEN494 IF (iguide_read.LT.0) THEN 494 495 tau=ditau/dday_step/REAL(iguide_read) 495 496 ELSE … … 497 498 ENDIF 498 499 reste=tau-AINT(tau) 499 IF (reste ==0.) THEN500 IF (itau_test ==itau) THEN500 IF (reste.EQ.0.) THEN 501 IF (itau_test.EQ.itau) THEN 501 502 write(*,*)trim(modname)//' second pass in advreel at itau=',& 502 503 itau … … 508 509 IF (guide_T) tnat1(:,jjbu:jjeu,:)=tnat2(:,jjbu:jjeu,:) 509 510 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) 512 513 !$OMP END MASTER 513 514 !$OMP BARRIER … … 540 541 ! Interpolation et conversion des champs de guidage 541 542 !----------------------------------------------------------------------- 542 IF (MOD(itau,iguide_int) ==0) THEN543 IF (MOD(itau,iguide_int).EQ.0) THEN 543 544 CALL guide_interp(ps,teta) 544 545 ENDIF 545 546 ! Repartition entre 2 etats de guidage 546 IF (iguide_read /=0) THEN547 IF (iguide_read.NE.0) THEN 547 548 tau=reste 548 549 ELSE … … 560 561 !----------------------------------------------------------------------- 561 562 ! 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) 563 564 IF (f_out) THEN 564 565 … … 803 804 IF (guide_reg) THEN 804 805 DO i=1,iim 805 IF (lond(i) <lon_min_g) imin(1)=i806 IF (lond(i) <=lon_max_g) imax(1)=i806 IF (lond(i).LT.lon_min_g) imin(1)=i 807 IF (lond(i).LE.lon_max_g) imax(1)=i 807 808 ENDDO 808 809 lond=rlonv*180./pi 809 810 DO i=1,iim 810 IF (lond(i) <lon_min_g) imin(2)=i811 IF (lond(i) <=lon_max_g) imax(2)=i811 IF (lond(i).LT.lon_min_g) imin(2)=i 812 IF (lond(i).LE.lon_max_g) imax(2)=i 812 813 ENDDO 813 814 ENDIF … … 875 876 IF (guide_reg) THEN 876 877 DO i=1,iim 877 IF (lond(i) <lon_min_g) imin(1)=i878 IF (lond(i) <=lon_max_g) imax(1)=i878 IF (lond(i).LT.lon_min_g) imin(1)=i 879 IF (lond(i).LE.lon_max_g) imax(1)=i 879 880 ENDDO 880 881 lond=rlonv*180./pi 881 882 DO i=1,iim 882 IF (lond(i) <lon_min_g) imin(2)=i883 IF (lond(i) <=lon_max_g) imax(2)=i883 IF (lond(i).LT.lon_min_g) imin(2)=i 884 IF (lond(i).LE.lon_max_g) imax(2)=i 884 885 ENDDO 885 886 ENDIF … … 982 983 983 984 984 IF (guide_plevs ==0) THEN985 IF (guide_plevs.EQ.0) THEN 985 986 !$OMP DO 986 987 DO l=1,nlevnc … … 1048 1049 1049 1050 ! .... Calcul de pls , pression au milieu des couches ,en Pascals 1050 IF (guide_plevs ==1) THEN1051 IF (guide_plevs.EQ.1) THEN 1051 1052 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1052 1053 DO l=1,llm … … 1127 1128 IF (guide_T) THEN 1128 1129 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1129 IF (guide_plevs ==1) THEN1130 IF (guide_plevs.EQ.1) THEN 1130 1131 !$OMP DO 1131 1132 DO l=1,nlevnc … … 1137 1138 ENDDO 1138 1139 ENDDO 1139 ELSE IF (guide_plevs ==2) THEN1140 ELSE IF (guide_plevs.EQ.2) THEN 1140 1141 !$OMP DO 1141 1142 DO l=1,nlevnc … … 1194 1195 IF (guide_Q) THEN 1195 1196 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1196 IF (guide_plevs ==1) THEN1197 IF (guide_plevs.EQ.1) THEN 1197 1198 !$OMP DO 1198 1199 DO l=1,nlevnc … … 1204 1205 ENDDO 1205 1206 ENDDO 1206 ELSE IF (guide_plevs ==2) THEN1207 ELSE IF (guide_plevs.EQ.2) THEN 1207 1208 !$OMP DO 1208 1209 DO l=1,nlevnc … … 1266 1267 IF (guide_u) THEN 1267 1268 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1268 IF (guide_plevs ==1) THEN1269 IF (guide_plevs.EQ.1) THEN 1269 1270 !$OMP DO 1270 1271 DO l=1,nlevnc … … 1280 1281 ENDDO 1281 1282 ENDDO 1282 ELSE IF (guide_plevs ==2) THEN1283 ELSE IF (guide_plevs.EQ.2) THEN 1283 1284 !$OMP DO 1284 1285 DO l=1,nlevnc … … 1334 1335 IF (guide_v) THEN 1335 1336 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1336 IF (guide_plevs ==1) THEN1337 IF (guide_plevs.EQ.1) THEN 1337 1338 CALL Register_Hallo_u(psnat1,1,1,2,2,1,Req) 1338 1339 CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req) … … 1352 1353 ENDDO 1353 1354 ENDDO 1354 ELSE IF (guide_plevs ==2) THEN1355 ELSE IF (guide_plevs.EQ.2) THEN 1355 1356 CALL Register_Hallo_u(pnat1,llm,1,2,2,1,Req) 1356 1357 CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req) … … 1444 1445 do j=jjb,jje 1445 1446 do i=1,pim 1446 if (typ ==2) then1447 if (typ.eq.2) then 1447 1448 zlat=rlatu(j)*180./pi 1448 1449 zlon=rlonu(i)*180./pi 1449 elseif (typ ==1) then1450 elseif (typ.eq.1) then 1450 1451 zlat=rlatu(j)*180./pi 1451 1452 zlon=rlonv(i)*180./pi 1452 elseif (typ ==3) then1453 elseif (typ.eq.3) then 1453 1454 zlat=rlatv(j)*180./pi 1454 1455 zlon=rlonv(i)*180./pi … … 1489 1490 enddo 1490 1491 enddo 1491 IF (typ ==2) THEN1492 IF (typ.EQ.2) THEN 1492 1493 do j=1,jjp1 1493 1494 do i=1,iim … … 1497 1498 enddo 1498 1499 ENDIF 1499 IF (typ ==3) THEN1500 IF (typ.EQ.3) THEN 1500 1501 do j=1,jjm 1501 1502 do i=1,iip1 … … 1519 1520 enddo 1520 1521 ! Calcul de gamma 1521 if (abs(grossismx-1.) <0.1.or.abs(grossismy-1.)<0.1) then1522 if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then 1522 1523 write(*,*)trim(modname)//' ATTENTION modele peu zoome' 1523 1524 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' … … 1526 1527 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1527 1528 write(*,*)trim(modname)//' gamma=',gamma 1528 if (gamma <1.e-5) then1529 if (gamma.lt.1.e-5) then 1529 1530 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1530 1531 CALL abort_gcm("guide_loc_mod","stopped",1) … … 1540 1541 do j=jjb,jje 1541 1542 do i=1,pim 1542 if (typ ==1) then1543 if (typ.eq.1) then 1543 1544 dxdy_=dxdys(i,j) 1544 1545 zlat=rlatu(j)*180./pi 1545 elseif (typ ==2) then1546 elseif (typ.eq.2) then 1546 1547 dxdy_=dxdyu(i,j) 1547 1548 zlat=rlatu(j)*180./pi 1548 elseif (typ ==3) then1549 elseif (typ.eq.3) then 1549 1550 dxdy_=dxdyv(i,j) 1550 1551 zlat=rlatv(j)*180./pi 1551 1552 endif 1552 if (abs(grossismx-1.) <0.1.or.abs(grossismy-1.)<0.1) then1553 if (abs(grossismx-1.).lt.0.1.or.abs(grossismy-1.).lt.0.1) then 1553 1554 ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin 1554 1555 alpha(i,j)=alphamin … … 1556 1557 xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma 1557 1558 xi=min(xi,1.) 1558 if(lat_min_g <=zlat .and. zlat<=lat_max_g) then1559 if(lat_min_g.le.zlat .and. zlat.le.lat_max_g) then 1559 1560 alpha(i,j)=xi*alphamin+(1.-xi)*alphamax 1560 1561 else … … 1575 1576 IMPLICIT NONE 1576 1577 1578 include "netcdf.inc" 1577 1579 include "dimensions.h" 1578 1580 include "paramet.h" … … 1600 1602 write(*,*),trim(modname)//': opening nudging files ' 1601 1603 ! Ap et Bp si Niveaux de pression hybrides 1602 if (guide_plevs ==1) then1604 if (guide_plevs.EQ.1) then 1603 1605 write(*,*),trim(modname)//' Reading nudging on model levels' 1604 1606 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1605 IF (rcode /=NF_NOERR) THEN1607 IF (rcode.NE.NF_NOERR) THEN 1606 1608 abort_message='Nudging: error -> no file apbp.nc' 1607 1609 CALL abort_gcm(modname,abort_message,1) 1608 1610 ENDIF 1609 1611 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1610 IF (rcode /=NF_NOERR) THEN1612 IF (rcode.NE.NF_NOERR) THEN 1611 1613 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1612 1614 CALL abort_gcm(modname,abort_message,1) 1613 1615 ENDIF 1614 1616 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1615 IF (rcode /=NF_NOERR) THEN1617 IF (rcode.NE.NF_NOERR) THEN 1616 1618 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1617 1619 CALL abort_gcm(modname,abort_message,1) … … 1621 1623 1622 1624 ! Pression si guidage sur niveaux P variables 1623 if (guide_plevs ==2) then1625 if (guide_plevs.EQ.2) then 1624 1626 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1625 IF (rcode /=NF_NOERR) THEN1627 IF (rcode.NE.NF_NOERR) THEN 1626 1628 abort_message='Nudging: error -> no file P.nc' 1627 1629 CALL abort_gcm(modname,abort_message,1) 1628 1630 ENDIF 1629 1631 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1630 IF (rcode /=NF_NOERR) THEN1632 IF (rcode.NE.NF_NOERR) THEN 1631 1633 abort_message='Nudging: error -> no PRES variable in file P.nc' 1632 1634 CALL abort_gcm(modname,abort_message,1) 1633 1635 ENDIF 1634 1636 write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp 1635 if (ncidpl ==-99) ncidpl=ncidp1637 if (ncidpl.eq.-99) ncidpl=ncidp 1636 1638 endif 1637 1639 … … 1639 1641 if (guide_u) then 1640 1642 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1641 IF (rcode /=NF_NOERR) THEN1643 IF (rcode.NE.NF_NOERR) THEN 1642 1644 abort_message='Nudging: error -> no file u.nc' 1643 1645 CALL abort_gcm(modname,abort_message,1) 1644 1646 ENDIF 1645 1647 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1646 IF (rcode /=NF_NOERR) THEN1648 IF (rcode.NE.NF_NOERR) THEN 1647 1649 abort_message='Nudging: error -> no UWND variable in file u.nc' 1648 1650 CALL abort_gcm(modname,abort_message,1) 1649 1651 ENDIF 1650 1652 write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu 1651 if (ncidpl ==-99) ncidpl=ncidu1653 if (ncidpl.eq.-99) ncidpl=ncidu 1652 1654 1653 1655 1654 1656 status=NF90_INQ_DIMID(ncidu, "LONU", dimid) 1655 1657 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1656 IF (lendim /=iip1) THEN1658 IF (lendim .NE. iip1) THEN 1657 1659 abort_message='dimension LONU different from iip1 in u.nc' 1658 1660 CALL abort_gcm(modname,abort_message,1) … … 1661 1663 status=NF90_INQ_DIMID(ncidu, "LATU", dimid) 1662 1664 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1663 IF (lendim /=jjp1) THEN1665 IF (lendim .NE. jjp1) THEN 1664 1666 abort_message='dimension LATU different from jjp1 in u.nc' 1665 1667 CALL abort_gcm(modname,abort_message,1) … … 1671 1673 if (guide_v) then 1672 1674 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1673 IF (rcode /=NF_NOERR) THEN1675 IF (rcode.NE.NF_NOERR) THEN 1674 1676 abort_message='Nudging: error -> no file v.nc' 1675 1677 CALL abort_gcm(modname,abort_message,1) 1676 1678 ENDIF 1677 1679 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1678 IF (rcode /=NF_NOERR) THEN1680 IF (rcode.NE.NF_NOERR) THEN 1679 1681 abort_message='Nudging: error -> no VWND variable in file v.nc' 1680 1682 CALL abort_gcm(modname,abort_message,1) 1681 1683 ENDIF 1682 1684 write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv 1683 if (ncidpl ==-99) ncidpl=ncidv1685 if (ncidpl.eq.-99) ncidpl=ncidv 1684 1686 1685 1687 status=NF90_INQ_DIMID(ncidv, "LONV", dimid) 1686 1688 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1687 1689 1688 IF (lendim /=iip1) THEN1690 IF (lendim .NE. iip1) THEN 1689 1691 abort_message='dimension LONV different from iip1 in v.nc' 1690 1692 CALL abort_gcm(modname,abort_message,1) … … 1694 1696 status=NF90_INQ_DIMID(ncidv, "LATV", dimid) 1695 1697 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1696 IF (lendim /=jjm) THEN1698 IF (lendim .NE. jjm) THEN 1697 1699 abort_message='dimension LATV different from jjm in v.nc' 1698 1700 CALL abort_gcm(modname,abort_message,1) … … 1704 1706 if (guide_T) then 1705 1707 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1706 IF (rcode /=NF_NOERR) THEN1708 IF (rcode.NE.NF_NOERR) THEN 1707 1709 abort_message='Nudging: error -> no file T.nc' 1708 1710 CALL abort_gcm(modname,abort_message,1) 1709 1711 ENDIF 1710 1712 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1711 IF (rcode /=NF_NOERR) THEN1713 IF (rcode.NE.NF_NOERR) THEN 1712 1714 abort_message='Nudging: error -> no AIR variable in file T.nc' 1713 1715 CALL abort_gcm(modname,abort_message,1) 1714 1716 ENDIF 1715 1717 write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt 1716 if (ncidpl ==-99) ncidpl=ncidt1718 if (ncidpl.eq.-99) ncidpl=ncidt 1717 1719 1718 1720 status=NF90_INQ_DIMID(ncidt, "LONV", dimid) 1719 1721 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1720 IF (lendim /=iip1) THEN1722 IF (lendim .NE. iip1) THEN 1721 1723 abort_message='dimension LONV different from iip1 in T.nc' 1722 1724 CALL abort_gcm(modname,abort_message,1) … … 1725 1727 status=NF90_INQ_DIMID(ncidt, "LATU", dimid) 1726 1728 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1727 IF (lendim /=jjp1) THEN1729 IF (lendim .NE. jjp1) THEN 1728 1730 abort_message='dimension LATU different from jjp1 in T.nc' 1729 1731 CALL abort_gcm(modname,abort_message,1) … … 1735 1737 if (guide_Q) then 1736 1738 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1737 IF (rcode /=NF_NOERR) THEN1739 IF (rcode.NE.NF_NOERR) THEN 1738 1740 abort_message='Nudging: error -> no file hur.nc' 1739 1741 CALL abort_gcm(modname,abort_message,1) 1740 1742 ENDIF 1741 1743 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1742 IF (rcode /=NF_NOERR) THEN1744 IF (rcode.NE.NF_NOERR) THEN 1743 1745 abort_message='Nudging: error -> no RH variable in file hur.nc' 1744 1746 CALL abort_gcm(modname,abort_message,1) 1745 1747 ENDIF 1746 1748 write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1747 if (ncidpl ==-99) ncidpl=ncidQ1749 if (ncidpl.eq.-99) ncidpl=ncidQ 1748 1750 1749 1751 1750 1752 status=NF90_INQ_DIMID(ncidQ, "LONV", dimid) 1751 1753 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1752 IF (lendim /=iip1) THEN1754 IF (lendim .NE. iip1) THEN 1753 1755 abort_message='dimension LONV different from iip1 in hur.nc' 1754 1756 CALL abort_gcm(modname,abort_message,1) … … 1757 1759 status=NF90_INQ_DIMID(ncidQ, "LATU", dimid) 1758 1760 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1759 IF (lendim /=jjp1) THEN1761 IF (lendim .NE. jjp1) THEN 1760 1762 abort_message='dimension LATU different from jjp1 in hur.nc' 1761 1763 CALL abort_gcm(modname,abort_message,1) … … 1765 1767 endif 1766 1768 ! Pression de surface 1767 if ((guide_P).OR.(guide_plevs ==1)) then1769 if ((guide_P).OR.(guide_plevs.EQ.1)) then 1768 1770 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1769 IF (rcode /=NF_NOERR) THEN1771 IF (rcode.NE.NF_NOERR) THEN 1770 1772 abort_message='Nudging: error -> no file ps.nc' 1771 1773 CALL abort_gcm(modname,abort_message,1) 1772 1774 ENDIF 1773 1775 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1774 IF (rcode /=NF_NOERR) THEN1776 IF (rcode.NE.NF_NOERR) THEN 1775 1777 abort_message='Nudging: error -> no SP variable in file ps.nc' 1776 1778 CALL abort_gcm(modname,abort_message,1) … … 1779 1781 endif 1780 1782 ! Coordonnee verticale 1781 if (guide_plevs ==0) then1783 if (guide_plevs.EQ.0) then 1782 1784 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) 1784 1786 write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1785 1787 endif 1786 1788 ! 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 1792 1803 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous 1793 1804 IF(convert_Pa) apnc=apnc*100.! conversion en Pascals … … 1814 1825 IF (invert_y) start(2)=jjp1-jje_u+1 1815 1826 ! 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 1818 1833 IF (invert_y) THEN 1819 1834 ! PRINT*,"Invertion impossible actuellement" … … 1825 1840 ! Vent zonal 1826 1841 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 1828 1847 IF (invert_y) THEN 1829 1848 ! PRINT*,"Invertion impossible actuellement" … … 1837 1856 ! Temperature 1838 1857 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 1840 1863 IF (invert_y) THEN 1841 1864 ! PRINT*,"Invertion impossible actuellement" … … 1847 1870 ! Humidite 1848 1871 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 1850 1877 IF (invert_y) THEN 1851 1878 ! PRINT*,"Invertion impossible actuellement" … … 1862 1889 IF (invert_y) start(2)=jjm-jje_v+1 1863 1890 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 1865 1896 IF (invert_y) THEN 1866 1897 ! PRINT*,"Invertion impossible actuellement" … … 1871 1902 1872 1903 ! Pression de surface 1873 if ((guide_P).OR.(guide_plevs ==1)) then1904 if ((guide_P).OR.(guide_plevs.EQ.1)) then 1874 1905 start(2)=jjb_u 1875 1906 start(3)=timestep … … 1879 1910 count(4)=0 1880 1911 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 1882 1917 IF (invert_y) THEN 1883 1918 ! PRINT*,"Invertion impossible actuellement" … … 1894 1929 IMPLICIT NONE 1895 1930 1931 include "netcdf.inc" 1896 1932 include "dimensions.h" 1897 1933 include "paramet.h" … … 1922 1958 write(*,*)trim(modname)//' : opening nudging files ' 1923 1959 ! Ap et Bp si niveaux de pression hybrides 1924 if (guide_plevs ==1) then1960 if (guide_plevs.EQ.1) then 1925 1961 write(*,*)trim(modname)//' Reading nudging on model levels' 1926 1962 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1927 IF (rcode /=NF_NOERR) THEN1963 IF (rcode.NE.NF_NOERR) THEN 1928 1964 abort_message='Nudging: error -> no file apbp.nc' 1929 1965 CALL abort_gcm(modname,abort_message,1) 1930 1966 ENDIF 1931 1967 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1932 IF (rcode /=NF_NOERR) THEN1968 IF (rcode.NE.NF_NOERR) THEN 1933 1969 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1934 1970 CALL abort_gcm(modname,abort_message,1) 1935 1971 ENDIF 1936 1972 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1937 IF (rcode /=NF_NOERR) THEN1973 IF (rcode.NE.NF_NOERR) THEN 1938 1974 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1939 1975 CALL abort_gcm(modname,abort_message,1) … … 1942 1978 endif 1943 1979 ! Pression 1944 if (guide_plevs ==2) then1980 if (guide_plevs.EQ.2) then 1945 1981 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1946 IF (rcode /=NF_NOERR) THEN1982 IF (rcode.NE.NF_NOERR) THEN 1947 1983 abort_message='Nudging: error -> no file P.nc' 1948 1984 CALL abort_gcm(modname,abort_message,1) 1949 1985 ENDIF 1950 1986 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1951 IF (rcode /=NF_NOERR) THEN1987 IF (rcode.NE.NF_NOERR) THEN 1952 1988 abort_message='Nudging: error -> no PRES variable in file P.nc' 1953 1989 CALL abort_gcm(modname,abort_message,1) 1954 1990 ENDIF 1955 1991 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1956 if (ncidpl ==-99) ncidpl=ncidp1992 if (ncidpl.eq.-99) ncidpl=ncidp 1957 1993 endif 1958 1994 ! Vent zonal 1959 1995 if (guide_u) then 1960 1996 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1961 IF (rcode /=NF_NOERR) THEN1997 IF (rcode.NE.NF_NOERR) THEN 1962 1998 abort_message='Nudging: error -> no file u.nc' 1963 1999 CALL abort_gcm(modname,abort_message,1) 1964 2000 ENDIF 1965 2001 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1966 IF (rcode /=NF_NOERR) THEN2002 IF (rcode.NE.NF_NOERR) THEN 1967 2003 abort_message='Nudging: error -> no UWND variable in file u.nc' 1968 2004 CALL abort_gcm(modname,abort_message,1) 1969 2005 ENDIF 1970 2006 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 1971 if (ncidpl ==-99) ncidpl=ncidu2007 if (ncidpl.eq.-99) ncidpl=ncidu 1972 2008 endif 1973 2009 … … 1975 2011 if (guide_v) then 1976 2012 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1977 IF (rcode /=NF_NOERR) THEN2013 IF (rcode.NE.NF_NOERR) THEN 1978 2014 abort_message='Nudging: error -> no file v.nc' 1979 2015 CALL abort_gcm(modname,abort_message,1) 1980 2016 ENDIF 1981 2017 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1982 IF (rcode /=NF_NOERR) THEN2018 IF (rcode.NE.NF_NOERR) THEN 1983 2019 abort_message='Nudging: error -> no VWND variable in file v.nc' 1984 2020 CALL abort_gcm(modname,abort_message,1) 1985 2021 ENDIF 1986 2022 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 1987 if (ncidpl ==-99) ncidpl=ncidv2023 if (ncidpl.eq.-99) ncidpl=ncidv 1988 2024 endif 1989 2025 ! Temperature 1990 2026 if (guide_T) then 1991 2027 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1992 IF (rcode /=NF_NOERR) THEN2028 IF (rcode.NE.NF_NOERR) THEN 1993 2029 abort_message='Nudging: error -> no file T.nc' 1994 2030 CALL abort_gcm(modname,abort_message,1) 1995 2031 ENDIF 1996 2032 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1997 IF (rcode /=NF_NOERR) THEN2033 IF (rcode.NE.NF_NOERR) THEN 1998 2034 abort_message='Nudging: error -> no AIR variable in file T.nc' 1999 2035 CALL abort_gcm(modname,abort_message,1) 2000 2036 ENDIF 2001 2037 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 2002 if (ncidpl ==-99) ncidpl=ncidt2038 if (ncidpl.eq.-99) ncidpl=ncidt 2003 2039 endif 2004 2040 ! Humidite 2005 2041 if (guide_Q) then 2006 2042 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 2007 IF (rcode /=NF_NOERR) THEN2043 IF (rcode.NE.NF_NOERR) THEN 2008 2044 abort_message='Nudging: error -> no file hur.nc' 2009 2045 CALL abort_gcm(modname,abort_message,1) 2010 2046 ENDIF 2011 2047 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 2012 IF (rcode /=NF_NOERR) THEN2048 IF (rcode.NE.NF_NOERR) THEN 2013 2049 abort_message='Nudging: error -> no RH,variable in file hur.nc' 2014 2050 CALL abort_gcm(modname,abort_message,1) 2015 2051 ENDIF 2016 2052 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 2017 if (ncidpl ==-99) ncidpl=ncidQ2053 if (ncidpl.eq.-99) ncidpl=ncidQ 2018 2054 endif 2019 2055 ! Pression de surface 2020 if ((guide_P).OR.(guide_plevs ==1)) then2056 if ((guide_P).OR.(guide_plevs.EQ.1)) then 2021 2057 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 2022 IF (rcode /=NF_NOERR) THEN2058 IF (rcode.NE.NF_NOERR) THEN 2023 2059 abort_message='Nudging: error -> no file ps.nc' 2024 2060 CALL abort_gcm(modname,abort_message,1) 2025 2061 ENDIF 2026 2062 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 2027 IF (rcode /=NF_NOERR) THEN2063 IF (rcode.NE.NF_NOERR) THEN 2028 2064 abort_message='Nudging: error -> no SP variable in file ps.nc' 2029 2065 CALL abort_gcm(modname,abort_message,1) … … 2032 2068 endif 2033 2069 ! Coordonnee verticale 2034 if (guide_plevs ==0) then2070 if (guide_plevs.EQ.0) then 2035 2071 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) 2037 2073 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 2038 2074 endif 2039 2075 ! 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 2045 2090 apnc=apnc*100.! conversion en Pascals 2046 2091 bpnc(:)=0. … … 2066 2111 IF (invert_y) start(2)=jjp1-jje_u+1 2067 2112 ! 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 2070 2119 DO i=1,iip1 2071 2120 pnat2(i,:,:)=zu(:,:) … … 2080 2129 ! Vent zonal 2081 2130 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 2083 2136 DO i=1,iip1 2084 2137 unat2(i,:,:)=zu(:,:) … … 2095 2148 ! Temperature 2096 2149 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 2098 2155 DO i=1,iip1 2099 2156 tnat2(i,:,:)=zu(:,:) … … 2109 2166 ! Humidite 2110 2167 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 2112 2173 DO i=1,iip1 2113 2174 qnat2(i,:,:)=zu(:,:) … … 2126 2187 count(2)=jjnb_v 2127 2188 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 2129 2194 DO i=1,iip1 2130 2195 vnat2(i,:,:)=zv(:,:) … … 2140 2205 2141 2206 ! Pression de surface 2142 if ((guide_P).OR.(guide_plevs ==1)) then2207 if ((guide_P).OR.(guide_plevs.EQ.1)) then 2143 2208 start(2)=jjb_u 2144 2209 start(3)=timestep … … 2148 2213 count(4)=0 2149 2214 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 2151 2220 DO i=1,iip1 2152 2221 psnat2(i,:)=zu(:,1) … … 2169 2238 USE comvert_mod, ONLY: presnivs 2170 2239 use netcdf95, only: nf95_def_var, nf95_put_var 2240 use netcdf, only: nf90_float 2171 2241 2172 2242 IMPLICIT NONE … … 2174 2244 INCLUDE "dimensions.h" 2175 2245 INCLUDE "paramet.h" 2246 INCLUDE "netcdf.inc" 2176 2247 INCLUDE "comgeom2.h" 2177 2248 … … 2225 2296 2226 2297 !$OMP MASTER 2227 IF (timestep ==0) THEN2298 IF (timestep.EQ.0) THEN 2228 2299 ! ---------------------------------------------- 2229 2300 ! initialisation fichier de sortie … … 2257 2328 2258 2329 ! 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 2268 2351 call nf95_put_var(nid, varid_alpha_t, zt) 2269 2352 call nf95_put_var(nid, varid_alpha_q, zq) … … 2355 2438 !$OMP MASTER 2356 2439 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 2358 2446 ierr = NF_CLOSE(nid) 2359 2447 … … 2374 2462 do l=1,nl 2375 2463 do i=2,iim-1 2376 if(abs(x(i,l)) >1.e10) then2464 if(abs(x(i,l)).gt.1.e10) then 2377 2465 zz=0.5*(x(i-1,l)+x(i+1,l)) 2378 2466 print*,'correction ',i,l,x(i,l),zz -
LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90
r5075 r5084 23 23 USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0 24 24 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 26 28 27 29 ! Author: Frederic Hourdin original: 15/01/93 … … 153 155 relief=0. 154 156 ierr = NF90_OPEN ('relief_in.nc', NF90_NOWRITE,nid_relief) 155 if (ierr ==NF90_NOERR) THEN157 if (ierr.EQ.NF90_NOERR) THEN 156 158 ierr=NF90_INQ_VARID(nid_relief,'RELIEF',varid) 157 159 if (ierr==NF90_NOERR) THEN … … 255 257 tetastrat=ttp*zsig**(-kappa) 256 258 tetapv=tetastrat 257 IF ((ok_pv).AND.(zsig <0.1)) THEN259 IF ((ok_pv).AND.(zsig.LT.0.1)) THEN 258 260 tetapv=tetastrat*(zsig*10.)**(kappa*cpp*gam_pv/1000./g) 259 261 ENDIF -
LMDZ6/trunk/libf/dyn3dmem/leapfrog_loc.F
r5066 r5084 28 28 USE allocate_field_mod 29 29 USE call_dissip_mod, ONLY : call_dissip 30 USE lmdz_call_calfis, ONLY : call_calfis30 USE call_calfis_mod, ONLY : call_calfis 31 31 USE leapfrog_mod, ONLY : ucov,vcov,teta,ps,masse,phis,q,dq 32 32 & ,ucovm1,vcovm1,tetam1,massem1,psm1,p,pks,pk,pkf,flxw -
LMDZ6/trunk/libf/dyn3dmem/leapfrog_mod.F90
r5066 r5084 44 44 USE integrd_mod,ONLY : integrd_allocate 45 45 USE caladvtrac_mod,ONLY : caladvtrac_allocate 46 USE lmdz_call_calfis,ONLY : call_calfis_allocate46 USE call_calfis_mod,ONLY : call_calfis_allocate 47 47 USE call_dissip_mod, ONLY : call_dissip_allocate 48 48 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.
