Changeset 5070 for LMDZ6/trunk/libf
- Timestamp:
- Jul 18, 2024, 3:06:28 PM (4 months ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/dyn3dmem/guide_loc_mod.F90 (modified) (57 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/guide_loc_mod.F90
r5069 r5070 125 125 CALL getpar('iguide_sav',4,iguide_sav,'freq. sauvegarde guidage') 126 126 ! frequences f>0: fx/jour; f<0: tous les f jours; f=0: 1 seule fois. 127 IF (iguide_sav .GT.0) THEN127 IF (iguide_sav>0) THEN 128 128 iguide_sav=day_step/iguide_sav 129 129 ELSE if (iguide_sav == 0) then … … 145 145 CALL getpar('iguide_read',4,iguide_read,'freq. lecture guidage') 146 146 CALL getpar('iguide_int',4,iguide_int,'freq. interpolation vert') 147 IF (iguide_int .EQ.0) THEN147 IF (iguide_int==0) THEN 148 148 iguide_int=1 149 ELSEIF (iguide_int .GT.0) THEN149 ELSEIF (iguide_int>0) THEN 150 150 iguide_int=day_step/iguide_int 151 151 ELSE … … 173 173 ! --------------------------------------------- 174 174 ncidpl=-99 175 if (guide_plevs .EQ.1) then176 if (ncidpl .eq.-99) then175 if (guide_plevs==1) then 176 if (ncidpl==-99) then 177 177 rcod=nf90_open('apbp.nc',Nf90_NOWRITe, ncidpl) 178 if (rcod .NE.NF_NOERR) THEN178 if (rcod/=NF_NOERR) THEN 179 179 abort_message=' Nudging error -> no file apbp.nc' 180 180 CALL abort_gcm(modname,abort_message,1) 181 181 endif 182 182 endif 183 elseif (guide_plevs .EQ.2) then184 if (ncidpl .EQ.-99) then183 elseif (guide_plevs==2) then 184 if (ncidpl==-99) then 185 185 rcod=nf90_open('P.nc',Nf90_NOWRITe,ncidpl) 186 if (rcod .NE.NF_NOERR) THEN186 if (rcod/=NF_NOERR) THEN 187 187 abort_message=' Nudging error -> no file P.nc' 188 188 CALL abort_gcm(modname,abort_message,1) … … 191 191 192 192 elseif (guide_u) then 193 if (ncidpl .eq.-99) then193 if (ncidpl==-99) then 194 194 rcod=nf90_open('u.nc',Nf90_NOWRITe,ncidpl) 195 if (rcod .NE.NF_NOERR) THEN195 if (rcod/=NF_NOERR) THEN 196 196 abort_message=' Nudging error -> no file u.nc' 197 197 CALL abort_gcm(modname,abort_message,1) … … 202 202 203 203 elseif (guide_v) then 204 if (ncidpl .eq.-99) then204 if (ncidpl==-99) then 205 205 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 206 if (rcod .NE.NF_NOERR) THEN206 if (rcod/=NF_NOERR) THEN 207 207 abort_message=' Nudging error -> no file v.nc' 208 208 CALL abort_gcm(modname,abort_message,1) … … 212 212 213 213 elseif (guide_T) then 214 if (ncidpl .eq.-99) then214 if (ncidpl==-99) then 215 215 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 216 if (rcod .NE.NF_NOERR) THEN216 if (rcod/=NF_NOERR) THEN 217 217 abort_message=' Nudging error -> no file T.nc' 218 218 CALL abort_gcm(modname,abort_message,1) … … 223 223 224 224 elseif (guide_Q) then 225 if (ncidpl .eq.-99) then225 if (ncidpl==-99) then 226 226 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 227 if (rcod .NE.NF_NOERR) THEN227 if (rcod/=NF_NOERR) THEN 228 228 abort_message=' Nudging error -> no file hur.nc' 229 229 CALL abort_gcm(modname,abort_message,1) … … 234 234 endif 235 235 error=NF_INQ_DIMID(ncidpl,'LEVEL',rid) 236 IF (error .NE.NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid)237 IF (error .NE.NF_NOERR) THEN236 IF (error/=NF_NOERR) error=NF_INQ_DIMID(ncidpl,'PRESSURE',rid) 237 IF (error/=NF_NOERR) THEN 238 238 abort_message='Nudging: error reading pressure levels' 239 239 CALL abort_gcm(modname,abort_message,1) … … 316 316 ENDIF 317 317 318 IF (guide_plevs .EQ.2) THEN318 IF (guide_plevs==2) THEN 319 319 ALLOCATE(pnat1(iip1,jjb_u:jje_u,nlevnc), stat = error) 320 320 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 324 324 ENDIF 325 325 326 IF (guide_P.OR.guide_plevs .EQ.1) THEN326 IF (guide_P.OR.guide_plevs==1) THEN 327 327 ALLOCATE(psnat1(iip1,jjb_u:jje_u), stat = error) 328 328 IF (error /= 0) CALL abort_gcm(modname,abort_message,1) … … 351 351 IF (guide_T) tnat1=tnat2 352 352 IF (guide_Q) qnat1=qnat2 353 IF (guide_plevs .EQ.2) pnat1=pnat2354 IF (guide_P.OR.guide_plevs .EQ.1) psnat1=psnat2353 IF (guide_plevs==2) pnat1=pnat2 354 IF (guide_P.OR.guide_plevs==1) psnat1=psnat2 355 355 356 356 END SUBROUTINE guide_init … … 488 488 ! Lecture des fichiers de guidage ? 489 489 !----------------------------------------------------------------------- 490 IF (iguide_read .NE.0) THEN490 IF (iguide_read/=0) THEN 491 491 ditau=real(itau) 492 492 dday_step=real(day_step) 493 IF (iguide_read .LT.0) THEN493 IF (iguide_read<0) THEN 494 494 tau=ditau/dday_step/REAL(iguide_read) 495 495 ELSE … … 497 497 ENDIF 498 498 reste=tau-AINT(tau) 499 IF (reste .EQ.0.) THEN500 IF (itau_test .EQ.itau) THEN499 IF (reste==0.) THEN 500 IF (itau_test==itau) THEN 501 501 write(*,*)trim(modname)//' second pass in advreel at itau=',& 502 502 itau … … 508 508 IF (guide_T) tnat1(:,jjbu:jjeu,:)=tnat2(:,jjbu:jjeu,:) 509 509 IF (guide_Q) qnat1(:,jjbu:jjeu,:)=qnat2(:,jjbu:jjeu,:) 510 IF (guide_plevs .EQ.2) pnat1(:,jjbu:jjeu,:)=pnat2(:,jjbu:jjeu,:)511 IF (guide_P.OR.guide_plevs .EQ.1) psnat1(:,jjbu:jjeu)=psnat2(:,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) 512 512 !$OMP END MASTER 513 513 !$OMP BARRIER … … 540 540 ! Interpolation et conversion des champs de guidage 541 541 !----------------------------------------------------------------------- 542 IF (MOD(itau,iguide_int) .EQ.0) THEN542 IF (MOD(itau,iguide_int)==0) THEN 543 543 CALL guide_interp(ps,teta) 544 544 ENDIF 545 545 ! Repartition entre 2 etats de guidage 546 IF (iguide_read .NE.0) THEN546 IF (iguide_read/=0) THEN 547 547 tau=reste 548 548 ELSE … … 560 560 !----------------------------------------------------------------------- 561 561 ! Sauvegarde du guidage? 562 f_out=((MOD(itau,iguide_sav) .EQ.0).AND.guide_sav)562 f_out=((MOD(itau,iguide_sav)==0).AND.guide_sav) 563 563 IF (f_out) THEN 564 564 … … 803 803 IF (guide_reg) THEN 804 804 DO i=1,iim 805 IF (lond(i) .LT.lon_min_g) imin(1)=i806 IF (lond(i) .LE.lon_max_g) imax(1)=i805 IF (lond(i)<lon_min_g) imin(1)=i 806 IF (lond(i)<=lon_max_g) imax(1)=i 807 807 ENDDO 808 808 lond=rlonv*180./pi 809 809 DO i=1,iim 810 IF (lond(i) .LT.lon_min_g) imin(2)=i811 IF (lond(i) .LE.lon_max_g) imax(2)=i810 IF (lond(i)<lon_min_g) imin(2)=i 811 IF (lond(i)<=lon_max_g) imax(2)=i 812 812 ENDDO 813 813 ENDIF … … 875 875 IF (guide_reg) THEN 876 876 DO i=1,iim 877 IF (lond(i) .LT.lon_min_g) imin(1)=i878 IF (lond(i) .LE.lon_max_g) imax(1)=i877 IF (lond(i)<lon_min_g) imin(1)=i 878 IF (lond(i)<=lon_max_g) imax(1)=i 879 879 ENDDO 880 880 lond=rlonv*180./pi 881 881 DO i=1,iim 882 IF (lond(i) .LT.lon_min_g) imin(2)=i883 IF (lond(i) .LE.lon_max_g) imax(2)=i882 IF (lond(i)<lon_min_g) imin(2)=i 883 IF (lond(i)<=lon_max_g) imax(2)=i 884 884 ENDDO 885 885 ENDIF … … 982 982 983 983 984 IF (guide_plevs .EQ.0) THEN984 IF (guide_plevs==0) THEN 985 985 !$OMP DO 986 986 DO l=1,nlevnc … … 1048 1048 1049 1049 ! .... Calcul de pls , pression au milieu des couches ,en Pascals 1050 IF (guide_plevs .EQ.1) THEN1050 IF (guide_plevs==1) THEN 1051 1051 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 1052 1052 DO l=1,llm … … 1127 1127 IF (guide_T) THEN 1128 1128 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1129 IF (guide_plevs .EQ.1) THEN1129 IF (guide_plevs==1) THEN 1130 1130 !$OMP DO 1131 1131 DO l=1,nlevnc … … 1137 1137 ENDDO 1138 1138 ENDDO 1139 ELSE IF (guide_plevs .EQ.2) THEN1139 ELSE IF (guide_plevs==2) THEN 1140 1140 !$OMP DO 1141 1141 DO l=1,nlevnc … … 1194 1194 IF (guide_Q) THEN 1195 1195 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1196 IF (guide_plevs .EQ.1) THEN1196 IF (guide_plevs==1) THEN 1197 1197 !$OMP DO 1198 1198 DO l=1,nlevnc … … 1204 1204 ENDDO 1205 1205 ENDDO 1206 ELSE IF (guide_plevs .EQ.2) THEN1206 ELSE IF (guide_plevs==2) THEN 1207 1207 !$OMP DO 1208 1208 DO l=1,nlevnc … … 1266 1266 IF (guide_u) THEN 1267 1267 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1268 IF (guide_plevs .EQ.1) THEN1268 IF (guide_plevs==1) THEN 1269 1269 !$OMP DO 1270 1270 DO l=1,nlevnc … … 1280 1280 ENDDO 1281 1281 ENDDO 1282 ELSE IF (guide_plevs .EQ.2) THEN1282 ELSE IF (guide_plevs==2) THEN 1283 1283 !$OMP DO 1284 1284 DO l=1,nlevnc … … 1334 1334 IF (guide_v) THEN 1335 1335 ! Calcul des nouvelles valeurs des niveaux de pression du guidage 1336 IF (guide_plevs .EQ.1) THEN1336 IF (guide_plevs==1) THEN 1337 1337 CALL Register_Hallo_u(psnat1,1,1,2,2,1,Req) 1338 1338 CALL Register_Hallo_u(psnat2,1,1,2,2,1,Req) … … 1352 1352 ENDDO 1353 1353 ENDDO 1354 ELSE IF (guide_plevs .EQ.2) THEN1354 ELSE IF (guide_plevs==2) THEN 1355 1355 CALL Register_Hallo_u(pnat1,llm,1,2,2,1,Req) 1356 1356 CALL Register_Hallo_u(pnat2,llm,1,2,2,1,Req) … … 1444 1444 do j=jjb,jje 1445 1445 do i=1,pim 1446 if (typ .eq.2) then1446 if (typ==2) then 1447 1447 zlat=rlatu(j)*180./pi 1448 1448 zlon=rlonu(i)*180./pi 1449 elseif (typ .eq.1) then1449 elseif (typ==1) then 1450 1450 zlat=rlatu(j)*180./pi 1451 1451 zlon=rlonv(i)*180./pi 1452 elseif (typ .eq.3) then1452 elseif (typ==3) then 1453 1453 zlat=rlatv(j)*180./pi 1454 1454 zlon=rlonv(i)*180./pi … … 1489 1489 enddo 1490 1490 enddo 1491 IF (typ .EQ.2) THEN1491 IF (typ==2) THEN 1492 1492 do j=1,jjp1 1493 1493 do i=1,iim … … 1497 1497 enddo 1498 1498 ENDIF 1499 IF (typ .EQ.3) THEN1499 IF (typ==3) THEN 1500 1500 do j=1,jjm 1501 1501 do i=1,iip1 … … 1519 1519 enddo 1520 1520 ! Calcul de gamma 1521 if (abs(grossismx-1.) .lt.0.1.or.abs(grossismy-1.).lt.0.1) then1521 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then 1522 1522 write(*,*)trim(modname)//' ATTENTION modele peu zoome' 1523 1523 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' … … 1526 1526 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1527 1527 write(*,*)trim(modname)//' gamma=',gamma 1528 if (gamma .lt.1.e-5) then1528 if (gamma<1.e-5) then 1529 1529 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1530 1530 CALL abort_gcm("guide_loc_mod","stopped",1) … … 1540 1540 do j=jjb,jje 1541 1541 do i=1,pim 1542 if (typ .eq.1) then1542 if (typ==1) then 1543 1543 dxdy_=dxdys(i,j) 1544 1544 zlat=rlatu(j)*180./pi 1545 elseif (typ .eq.2) then1545 elseif (typ==2) then 1546 1546 dxdy_=dxdyu(i,j) 1547 1547 zlat=rlatu(j)*180./pi 1548 elseif (typ .eq.3) then1548 elseif (typ==3) then 1549 1549 dxdy_=dxdyv(i,j) 1550 1550 zlat=rlatv(j)*180./pi 1551 1551 endif 1552 if (abs(grossismx-1.) .lt.0.1.or.abs(grossismy-1.).lt.0.1) then1552 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then 1553 1553 ! pour une grille reguliere, xi=xxx**0=1 -> alpha=alphamin 1554 1554 alpha(i,j)=alphamin … … 1556 1556 xi=((dxdy_max-dxdy_)/(dxdy_max-dxdy_min))**gamma 1557 1557 xi=min(xi,1.) 1558 if(lat_min_g .le.zlat .and. zlat.le.lat_max_g) then1558 if(lat_min_g<=zlat .and. zlat<=lat_max_g) then 1559 1559 alpha(i,j)=xi*alphamin+(1.-xi)*alphamax 1560 1560 else … … 1600 1600 write(*,*),trim(modname)//': opening nudging files ' 1601 1601 ! Ap et Bp si Niveaux de pression hybrides 1602 if (guide_plevs .EQ.1) then1602 if (guide_plevs==1) then 1603 1603 write(*,*),trim(modname)//' Reading nudging on model levels' 1604 1604 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1605 IF (rcode .NE.NF_NOERR) THEN1605 IF (rcode/=NF_NOERR) THEN 1606 1606 abort_message='Nudging: error -> no file apbp.nc' 1607 1607 CALL abort_gcm(modname,abort_message,1) 1608 1608 ENDIF 1609 1609 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1610 IF (rcode .NE.NF_NOERR) THEN1610 IF (rcode/=NF_NOERR) THEN 1611 1611 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1612 1612 CALL abort_gcm(modname,abort_message,1) 1613 1613 ENDIF 1614 1614 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1615 IF (rcode .NE.NF_NOERR) THEN1615 IF (rcode/=NF_NOERR) THEN 1616 1616 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1617 1617 CALL abort_gcm(modname,abort_message,1) … … 1621 1621 1622 1622 ! Pression si guidage sur niveaux P variables 1623 if (guide_plevs .EQ.2) then1623 if (guide_plevs==2) then 1624 1624 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1625 IF (rcode .NE.NF_NOERR) THEN1625 IF (rcode/=NF_NOERR) THEN 1626 1626 abort_message='Nudging: error -> no file P.nc' 1627 1627 CALL abort_gcm(modname,abort_message,1) 1628 1628 ENDIF 1629 1629 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1630 IF (rcode .NE.NF_NOERR) THEN1630 IF (rcode/=NF_NOERR) THEN 1631 1631 abort_message='Nudging: error -> no PRES variable in file P.nc' 1632 1632 CALL abort_gcm(modname,abort_message,1) 1633 1633 ENDIF 1634 1634 write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp 1635 if (ncidpl .eq.-99) ncidpl=ncidp1635 if (ncidpl==-99) ncidpl=ncidp 1636 1636 endif 1637 1637 … … 1639 1639 if (guide_u) then 1640 1640 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1641 IF (rcode .NE.NF_NOERR) THEN1641 IF (rcode/=NF_NOERR) THEN 1642 1642 abort_message='Nudging: error -> no file u.nc' 1643 1643 CALL abort_gcm(modname,abort_message,1) 1644 1644 ENDIF 1645 1645 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1646 IF (rcode .NE.NF_NOERR) THEN1646 IF (rcode/=NF_NOERR) THEN 1647 1647 abort_message='Nudging: error -> no UWND variable in file u.nc' 1648 1648 CALL abort_gcm(modname,abort_message,1) 1649 1649 ENDIF 1650 1650 write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu 1651 if (ncidpl .eq.-99) ncidpl=ncidu1651 if (ncidpl==-99) ncidpl=ncidu 1652 1652 1653 1653 1654 1654 status=NF90_INQ_DIMID(ncidu, "LONU", dimid) 1655 1655 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1656 IF (lendim .NE.iip1) THEN1656 IF (lendim /= iip1) THEN 1657 1657 abort_message='dimension LONU different from iip1 in u.nc' 1658 1658 CALL abort_gcm(modname,abort_message,1) … … 1661 1661 status=NF90_INQ_DIMID(ncidu, "LATU", dimid) 1662 1662 status=NF90_INQUIRE_DIMENSION(ncidu,dimid,namedim,lendim) 1663 IF (lendim .NE.jjp1) THEN1663 IF (lendim /= jjp1) THEN 1664 1664 abort_message='dimension LATU different from jjp1 in u.nc' 1665 1665 CALL abort_gcm(modname,abort_message,1) … … 1671 1671 if (guide_v) then 1672 1672 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1673 IF (rcode .NE.NF_NOERR) THEN1673 IF (rcode/=NF_NOERR) THEN 1674 1674 abort_message='Nudging: error -> no file v.nc' 1675 1675 CALL abort_gcm(modname,abort_message,1) 1676 1676 ENDIF 1677 1677 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1678 IF (rcode .NE.NF_NOERR) THEN1678 IF (rcode/=NF_NOERR) THEN 1679 1679 abort_message='Nudging: error -> no VWND variable in file v.nc' 1680 1680 CALL abort_gcm(modname,abort_message,1) 1681 1681 ENDIF 1682 1682 write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv 1683 if (ncidpl .eq.-99) ncidpl=ncidv1683 if (ncidpl==-99) ncidpl=ncidv 1684 1684 1685 1685 status=NF90_INQ_DIMID(ncidv, "LONV", dimid) 1686 1686 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1687 1687 1688 IF (lendim .NE.iip1) THEN1688 IF (lendim /= iip1) THEN 1689 1689 abort_message='dimension LONV different from iip1 in v.nc' 1690 1690 CALL abort_gcm(modname,abort_message,1) … … 1694 1694 status=NF90_INQ_DIMID(ncidv, "LATV", dimid) 1695 1695 status=NF90_INQUIRE_DIMENSION(ncidv,dimid,namedim,lendim) 1696 IF (lendim .NE.jjm) THEN1696 IF (lendim /= jjm) THEN 1697 1697 abort_message='dimension LATV different from jjm in v.nc' 1698 1698 CALL abort_gcm(modname,abort_message,1) … … 1704 1704 if (guide_T) then 1705 1705 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1706 IF (rcode .NE.NF_NOERR) THEN1706 IF (rcode/=NF_NOERR) THEN 1707 1707 abort_message='Nudging: error -> no file T.nc' 1708 1708 CALL abort_gcm(modname,abort_message,1) 1709 1709 ENDIF 1710 1710 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1711 IF (rcode .NE.NF_NOERR) THEN1711 IF (rcode/=NF_NOERR) THEN 1712 1712 abort_message='Nudging: error -> no AIR variable in file T.nc' 1713 1713 CALL abort_gcm(modname,abort_message,1) 1714 1714 ENDIF 1715 1715 write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt 1716 if (ncidpl .eq.-99) ncidpl=ncidt1716 if (ncidpl==-99) ncidpl=ncidt 1717 1717 1718 1718 status=NF90_INQ_DIMID(ncidt, "LONV", dimid) 1719 1719 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1720 IF (lendim .NE.iip1) THEN1720 IF (lendim /= iip1) THEN 1721 1721 abort_message='dimension LONV different from iip1 in T.nc' 1722 1722 CALL abort_gcm(modname,abort_message,1) … … 1725 1725 status=NF90_INQ_DIMID(ncidt, "LATU", dimid) 1726 1726 status=NF90_INQUIRE_DIMENSION(ncidt,dimid,namedim,lendim) 1727 IF (lendim .NE.jjp1) THEN1727 IF (lendim /= jjp1) THEN 1728 1728 abort_message='dimension LATU different from jjp1 in T.nc' 1729 1729 CALL abort_gcm(modname,abort_message,1) … … 1735 1735 if (guide_Q) then 1736 1736 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1737 IF (rcode .NE.NF_NOERR) THEN1737 IF (rcode/=NF_NOERR) THEN 1738 1738 abort_message='Nudging: error -> no file hur.nc' 1739 1739 CALL abort_gcm(modname,abort_message,1) 1740 1740 ENDIF 1741 1741 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 1742 IF (rcode .NE.NF_NOERR) THEN1742 IF (rcode/=NF_NOERR) THEN 1743 1743 abort_message='Nudging: error -> no RH variable in file hur.nc' 1744 1744 CALL abort_gcm(modname,abort_message,1) 1745 1745 ENDIF 1746 1746 write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1747 if (ncidpl .eq.-99) ncidpl=ncidQ1747 if (ncidpl==-99) ncidpl=ncidQ 1748 1748 1749 1749 1750 1750 status=NF90_INQ_DIMID(ncidQ, "LONV", dimid) 1751 1751 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1752 IF (lendim .NE.iip1) THEN1752 IF (lendim /= iip1) THEN 1753 1753 abort_message='dimension LONV different from iip1 in hur.nc' 1754 1754 CALL abort_gcm(modname,abort_message,1) … … 1757 1757 status=NF90_INQ_DIMID(ncidQ, "LATU", dimid) 1758 1758 status=NF90_INQUIRE_DIMENSION(ncidQ,dimid,namedim,lendim) 1759 IF (lendim .NE.jjp1) THEN1759 IF (lendim /= jjp1) THEN 1760 1760 abort_message='dimension LATU different from jjp1 in hur.nc' 1761 1761 CALL abort_gcm(modname,abort_message,1) … … 1765 1765 endif 1766 1766 ! Pression de surface 1767 if ((guide_P).OR.(guide_plevs .EQ.1)) then1767 if ((guide_P).OR.(guide_plevs==1)) then 1768 1768 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1769 IF (rcode .NE.NF_NOERR) THEN1769 IF (rcode/=NF_NOERR) THEN 1770 1770 abort_message='Nudging: error -> no file ps.nc' 1771 1771 CALL abort_gcm(modname,abort_message,1) 1772 1772 ENDIF 1773 1773 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 1774 IF (rcode .NE.NF_NOERR) THEN1774 IF (rcode/=NF_NOERR) THEN 1775 1775 abort_message='Nudging: error -> no SP variable in file ps.nc' 1776 1776 CALL abort_gcm(modname,abort_message,1) … … 1779 1779 endif 1780 1780 ! Coordonnee verticale 1781 if (guide_plevs .EQ.0) then1781 if (guide_plevs==0) then 1782 1782 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1783 IF (rcode .NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)1783 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1784 1784 write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1785 1785 endif 1786 1786 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 1787 IF (guide_plevs .EQ.1) THEN1787 IF (guide_plevs==1) THEN 1788 1788 status=nf_get_vara_rd(ncidpl,varidap,[1],[nlevnc],apnc) 1789 1789 status=nf_get_vara_rd(ncidpl,varidbp,[1],[nlevnc],bpnc) 1790 ELSEIF (guide_plevs .EQ.0) THEN1790 ELSEIF (guide_plevs==0) THEN 1791 1791 status=nf_get_vara_rd(ncidpl,varidpl,[1],[nlevnc],apnc) 1792 1792 !FC Pour les corrections la pression est deja en Pascals on commente la ligne ci-dessous … … 1814 1814 IF (invert_y) start(2)=jjp1-jje_u+1 1815 1815 ! Pression 1816 if (guide_plevs .EQ.2) then1816 if (guide_plevs==2) then 1817 1817 status=nf_get_vara_rd(ncidp,varidp,start,count,pnat2) 1818 1818 IF (invert_y) THEN … … 1871 1871 1872 1872 ! Pression de surface 1873 if ((guide_P).OR.(guide_plevs .EQ.1)) then1873 if ((guide_P).OR.(guide_plevs==1)) then 1874 1874 start(2)=jjb_u 1875 1875 start(3)=timestep … … 1922 1922 write(*,*)trim(modname)//' : opening nudging files ' 1923 1923 ! Ap et Bp si niveaux de pression hybrides 1924 if (guide_plevs .EQ.1) then1924 if (guide_plevs==1) then 1925 1925 write(*,*)trim(modname)//' Reading nudging on model levels' 1926 1926 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1927 IF (rcode .NE.NF_NOERR) THEN1927 IF (rcode/=NF_NOERR) THEN 1928 1928 abort_message='Nudging: error -> no file apbp.nc' 1929 1929 CALL abort_gcm(modname,abort_message,1) 1930 1930 ENDIF 1931 1931 rcode = nf90_inq_varid(ncidpl, 'AP', varidap) 1932 IF (rcode .NE.NF_NOERR) THEN1932 IF (rcode/=NF_NOERR) THEN 1933 1933 abort_message='Nudging: error -> no AP variable in file apbp.nc' 1934 1934 CALL abort_gcm(modname,abort_message,1) 1935 1935 ENDIF 1936 1936 rcode = nf90_inq_varid(ncidpl, 'BP', varidbp) 1937 IF (rcode .NE.NF_NOERR) THEN1937 IF (rcode/=NF_NOERR) THEN 1938 1938 abort_message='Nudging: error -> no BP variable in file apbp.nc' 1939 1939 CALL abort_gcm(modname,abort_message,1) … … 1942 1942 endif 1943 1943 ! Pression 1944 if (guide_plevs .EQ.2) then1944 if (guide_plevs==2) then 1945 1945 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1946 IF (rcode .NE.NF_NOERR) THEN1946 IF (rcode/=NF_NOERR) THEN 1947 1947 abort_message='Nudging: error -> no file P.nc' 1948 1948 CALL abort_gcm(modname,abort_message,1) 1949 1949 ENDIF 1950 1950 rcode = nf90_inq_varid(ncidp, 'PRES', varidp) 1951 IF (rcode .NE.NF_NOERR) THEN1951 IF (rcode/=NF_NOERR) THEN 1952 1952 abort_message='Nudging: error -> no PRES variable in file P.nc' 1953 1953 CALL abort_gcm(modname,abort_message,1) 1954 1954 ENDIF 1955 1955 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1956 if (ncidpl .eq.-99) ncidpl=ncidp1956 if (ncidpl==-99) ncidpl=ncidp 1957 1957 endif 1958 1958 ! Vent zonal 1959 1959 if (guide_u) then 1960 1960 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1961 IF (rcode .NE.NF_NOERR) THEN1961 IF (rcode/=NF_NOERR) THEN 1962 1962 abort_message='Nudging: error -> no file u.nc' 1963 1963 CALL abort_gcm(modname,abort_message,1) 1964 1964 ENDIF 1965 1965 rcode = nf90_inq_varid(ncidu, 'UWND', varidu) 1966 IF (rcode .NE.NF_NOERR) THEN1966 IF (rcode/=NF_NOERR) THEN 1967 1967 abort_message='Nudging: error -> no UWND variable in file u.nc' 1968 1968 CALL abort_gcm(modname,abort_message,1) 1969 1969 ENDIF 1970 1970 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 1971 if (ncidpl .eq.-99) ncidpl=ncidu1971 if (ncidpl==-99) ncidpl=ncidu 1972 1972 endif 1973 1973 … … 1975 1975 if (guide_v) then 1976 1976 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1977 IF (rcode .NE.NF_NOERR) THEN1977 IF (rcode/=NF_NOERR) THEN 1978 1978 abort_message='Nudging: error -> no file v.nc' 1979 1979 CALL abort_gcm(modname,abort_message,1) 1980 1980 ENDIF 1981 1981 rcode = nf90_inq_varid(ncidv, 'VWND', varidv) 1982 IF (rcode .NE.NF_NOERR) THEN1982 IF (rcode/=NF_NOERR) THEN 1983 1983 abort_message='Nudging: error -> no VWND variable in file v.nc' 1984 1984 CALL abort_gcm(modname,abort_message,1) 1985 1985 ENDIF 1986 1986 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 1987 if (ncidpl .eq.-99) ncidpl=ncidv1987 if (ncidpl==-99) ncidpl=ncidv 1988 1988 endif 1989 1989 ! Temperature 1990 1990 if (guide_T) then 1991 1991 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1992 IF (rcode .NE.NF_NOERR) THEN1992 IF (rcode/=NF_NOERR) THEN 1993 1993 abort_message='Nudging: error -> no file T.nc' 1994 1994 CALL abort_gcm(modname,abort_message,1) 1995 1995 ENDIF 1996 1996 rcode = nf90_inq_varid(ncidt, 'AIR', varidt) 1997 IF (rcode .NE.NF_NOERR) THEN1997 IF (rcode/=NF_NOERR) THEN 1998 1998 abort_message='Nudging: error -> no AIR variable in file T.nc' 1999 1999 CALL abort_gcm(modname,abort_message,1) 2000 2000 ENDIF 2001 2001 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 2002 if (ncidpl .eq.-99) ncidpl=ncidt2002 if (ncidpl==-99) ncidpl=ncidt 2003 2003 endif 2004 2004 ! Humidite 2005 2005 if (guide_Q) then 2006 2006 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 2007 IF (rcode .NE.NF_NOERR) THEN2007 IF (rcode/=NF_NOERR) THEN 2008 2008 abort_message='Nudging: error -> no file hur.nc' 2009 2009 CALL abort_gcm(modname,abort_message,1) 2010 2010 ENDIF 2011 2011 rcode = nf90_inq_varid(ncidQ, 'RH', varidQ) 2012 IF (rcode .NE.NF_NOERR) THEN2012 IF (rcode/=NF_NOERR) THEN 2013 2013 abort_message='Nudging: error -> no RH,variable in file hur.nc' 2014 2014 CALL abort_gcm(modname,abort_message,1) 2015 2015 ENDIF 2016 2016 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 2017 if (ncidpl .eq.-99) ncidpl=ncidQ2017 if (ncidpl==-99) ncidpl=ncidQ 2018 2018 endif 2019 2019 ! Pression de surface 2020 if ((guide_P).OR.(guide_plevs .EQ.1)) then2020 if ((guide_P).OR.(guide_plevs==1)) then 2021 2021 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 2022 IF (rcode .NE.NF_NOERR) THEN2022 IF (rcode/=NF_NOERR) THEN 2023 2023 abort_message='Nudging: error -> no file ps.nc' 2024 2024 CALL abort_gcm(modname,abort_message,1) 2025 2025 ENDIF 2026 2026 rcode = nf90_inq_varid(ncidps, 'SP', varidps) 2027 IF (rcode .NE.NF_NOERR) THEN2027 IF (rcode/=NF_NOERR) THEN 2028 2028 abort_message='Nudging: error -> no SP variable in file ps.nc' 2029 2029 CALL abort_gcm(modname,abort_message,1) … … 2032 2032 endif 2033 2033 ! Coordonnee verticale 2034 if (guide_plevs .EQ.0) then2034 if (guide_plevs==0) then 2035 2035 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 2036 IF (rcode .NE.0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)2036 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 2037 2037 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 2038 2038 endif 2039 2039 ! Coefs ap, bp pour calcul de la pression aux differents niveaux 2040 if (guide_plevs .EQ.1) then2040 if (guide_plevs==1) then 2041 2041 status=nf_get_vara_rd(ncidpl,varidap,[1],[nlevnc],apnc) 2042 2042 status=nf_get_vara_rd(ncidpl,varidbp,[1],[nlevnc],bpnc) 2043 elseif (guide_plevs .EQ.0) THEN2043 elseif (guide_plevs==0) THEN 2044 2044 status=nf_get_vara_rd(ncidpl,varidpl,[1],[nlevnc],apnc) 2045 2045 apnc=apnc*100.! conversion en Pascals … … 2066 2066 IF (invert_y) start(2)=jjp1-jje_u+1 2067 2067 ! Pression 2068 if (guide_plevs .EQ.2) then2068 if (guide_plevs==2) then 2069 2069 status=nf_get_vara_rd(ncidp,varidp,start,count,zu) 2070 2070 DO i=1,iip1 … … 2140 2140 2141 2141 ! Pression de surface 2142 if ((guide_P).OR.(guide_plevs .EQ.1)) then2142 if ((guide_P).OR.(guide_plevs==1)) then 2143 2143 start(2)=jjb_u 2144 2144 start(3)=timestep … … 2225 2225 2226 2226 !$OMP MASTER 2227 IF (timestep .EQ.0) THEN2227 IF (timestep==0) THEN 2228 2228 ! ---------------------------------------------- 2229 2229 ! initialisation fichier de sortie … … 2374 2374 do l=1,nl 2375 2375 do i=2,iim-1 2376 if(abs(x(i,l)) .gt.1.e10) then2376 if(abs(x(i,l))>1.e10) then 2377 2377 zz=0.5*(x(i-1,l)+x(i+1,l)) 2378 2378 print*,'correction ',i,l,x(i,l),zz
Note: See TracChangeset
for help on using the changeset viewer.
