- Timestamp:
- Jul 24, 2024, 2:54:37 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
r5113 r5116 6 6 !======================================================================= 7 7 8 USE getparam, only: ini_getparam, fin_getparam, getpar8 USE getparam, ONLY: ini_getparam, fin_getparam, getpar 9 9 USE Write_Field_loc 10 use netcdf, only: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, &10 use netcdf, ONLY: nf90_nowrite, nf90_open, nf90_inq_varid, nf90_close, & 11 11 nf90_inq_dimid, nf90_inquire_dimension, nf90_inq_dimid, & 12 12 nf90_inquire_dimension, nf90_enddef, nf90_def_dim, nf90_put_var, nf90_noerr, nf90_close, nf90_inq_varid, & … … 14 14 nf90_create, nf90_def_var, nf90_open 15 15 USE parallel_lmdz 16 USE pres2lev_mod, only: pres2lev16 USE pres2lev_mod, ONLY: pres2lev 17 17 18 18 IMPLICIT NONE … … 127 127 IF (iguide_sav>0) THEN 128 128 iguide_sav=day_step/iguide_sav 129 ELSE if (iguide_sav == 0) then129 ELSE if (iguide_sav == 0) THEN 130 130 iguide_sav = huge(0) 131 131 ELSE … … 173 173 ! --------------------------------------------- 174 174 ncidpl=-99 175 if (guide_plevs==1) then176 if (ncidpl==-99) then175 if (guide_plevs==1) THEN 176 if (ncidpl==-99) THEN 177 177 rcod=nf90_open('apbp.nc',nf90_nowrite, ncidpl) 178 178 if (rcod/=nf90_noerr) THEN … … 181 181 endif 182 182 endif 183 elseif (guide_plevs==2) then184 if (ncidpl==-99) then183 elseif (guide_plevs==2) THEN 184 if (ncidpl==-99) THEN 185 185 rcod=nf90_open('P.nc',nf90_nowrite,ncidpl) 186 186 if (rcod/=nf90_noerr) THEN … … 190 190 endif 191 191 192 elseif (guide_u) then193 if (ncidpl==-99) then192 elseif (guide_u) THEN 193 if (ncidpl==-99) THEN 194 194 rcod=nf90_open('u.nc',nf90_nowrite,ncidpl) 195 195 if (rcod/=nf90_noerr) THEN … … 201 201 202 202 203 elseif (guide_v) then204 if (ncidpl==-99) then203 elseif (guide_v) THEN 204 if (ncidpl==-99) THEN 205 205 rcod=nf90_open('v.nc',nf90_nowrite,ncidpl) 206 206 if (rcod/=nf90_noerr) THEN … … 211 211 212 212 213 elseif (guide_T) then214 if (ncidpl==-99) then213 elseif (guide_T) THEN 214 if (ncidpl==-99) THEN 215 215 rcod=nf90_open('T.nc',nf90_nowrite,ncidpl) 216 216 if (rcod/=nf90_noerr) THEN … … 222 222 223 223 224 elseif (guide_Q) then225 if (ncidpl==-99) then224 elseif (guide_Q) THEN 225 if (ncidpl==-99) THEN 226 226 rcod=nf90_open('hur.nc',nf90_nowrite, ncidpl) 227 227 if (rcod/=nf90_noerr) THEN … … 240 240 ENDIF 241 241 error=nf90_inquire_dimension(ncidpl,rid,len=nlevnc) 242 write(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc242 WRITE(*,*)trim(modname)//' : number of vertical levels nlevnc', nlevnc 243 243 rcod = nf90_close(ncidpl) 244 244 … … 358 358 !======================================================================= 359 359 SUBROUTINE guide_main(itau,ucov,vcov,teta,q,masse,ps) 360 use exner_hyb_loc_m, only: exner_hyb_loc361 use exner_milieu_loc_m, only: exner_milieu_loc360 use exner_hyb_loc_m, ONLY: exner_hyb_loc 361 use exner_milieu_loc_m, ONLY: exner_milieu_loc 362 362 USE parallel_lmdz 363 363 USE control_mod … … 451 451 CALL tau2alpha(1, iip1, jjb_u, jje_u, factt, tau_min_Q, tau_max_Q, alpha_Q) 452 452 ! correction de rappel dans couche limite 453 if (guide_BL) then453 if (guide_BL) THEN 454 454 alpha_pcor(:)=1. 455 455 else … … 499 499 IF (reste==0.) THEN 500 500 IF (itau_test==itau) THEN 501 write(*,*)trim(modname)//' second pass in advreel at itau=',&501 WRITE(*,*)trim(modname)//' second pass in advreel at itau=',& 502 502 itau 503 503 CALL abort_gcm("guide_loc_lod","stopped",1) … … 514 514 step_rea=step_rea+1 515 515 itau_test=itau 516 if (is_master) then517 write(*,*)trim(modname)//' Reading nudging files, step ',&516 if (is_master) THEN 517 WRITE(*,*)trim(modname)//' Reading nudging files, step ',& 518 518 step_rea,'after ',count_no_rea,' skips' 519 519 endif … … 567 567 568 568 !$OMP BARRIER 569 if (pressure_exner) then569 if (pressure_exner) THEN 570 570 CALL exner_hyb_loc( ijnb_u, ps, p, pks, pk) 571 571 else … … 588 588 ENDIF 589 589 590 if (guide_u) then591 if (guide_add) then590 if (guide_u) THEN 591 if (guide_add) THEN 592 592 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 593 593 DO l=1,llm … … 620 620 endif 621 621 622 if (guide_T) then623 if (guide_add) then622 if (guide_T) THEN 623 if (guide_add) THEN 624 624 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 625 625 DO l=1,llm … … 641 641 endif 642 642 643 if (guide_P) then644 if (guide_add) then643 if (guide_P) THEN 644 if (guide_add) THEN 645 645 !$OMP MASTER 646 646 f_addu(ijbu:ijeu,1)=(1.-tau)*psgui1(ijbu:ijeu)+tau*psgui2(ijbu:ijeu) … … 665 665 endif 666 666 667 if (guide_Q) then668 if (guide_add) then667 if (guide_Q) THEN 668 if (guide_add) THEN 669 669 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 670 670 DO l=1,llm … … 687 687 endif 688 688 689 if (guide_v) then690 if (guide_add) then689 if (guide_v) THEN 690 if (guide_add) THEN 691 691 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 692 692 DO l=1,llm … … 911 911 !======================================================================= 912 912 SUBROUTINE guide_interp(psi,teta) 913 use exner_hyb_loc_m, only: exner_hyb_loc914 use exner_milieu_loc_m, only: exner_milieu_loc913 use exner_hyb_loc_m, ONLY: exner_hyb_loc 914 use exner_milieu_loc_m, ONLY: exner_milieu_loc 915 915 USE parallel_lmdz 916 916 USE mod_hallo … … 952 952 !$OMP THREADPRIVATE(Req) 953 953 954 if (is_master) write(*,*)trim(modname)//': interpolate nudging variables'954 if (is_master) WRITE(*,*)trim(modname)//': interpolate nudging variables' 955 955 ! ----------------------------------------------------------------- 956 956 ! Calcul des niveaux de pression champs guidage (pour T et Q) … … 994 994 ENDIF 995 995 996 if (first) then996 if (first) THEN 997 997 first=.FALSE. 998 998 !$OMP MASTER 999 write(*,*)trim(modname)//' : check vertical level order'1000 write(*,*)trim(modname)//' LMDZ :'999 WRITE(*,*)trim(modname)//' : check vertical level order' 1000 WRITE(*,*)trim(modname)//' LMDZ :' 1001 1001 do l=1,llm 1002 write(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. &1002 WRITE(*,*)trim(modname)//' PL(',l,')=',(ap(l)+ap(l+1))/2. & 1003 1003 +psi(1,jjeu)*(bp(l)+bp(l+1))/2. 1004 1004 enddo 1005 write(*,*)trim(modname)//' nudging file :'1005 WRITE(*,*)trim(modname)//' nudging file :' 1006 1006 SELECT CASE (guide_plevs) 1007 1007 CASE (0) 1008 1008 do l=1,nlevnc 1009 write(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l)1009 WRITE(*,*)trim(modname)//' PL(',l,')=',plnc2(1,jjbu,l) 1010 1010 enddo 1011 1011 CASE (1) 1012 1012 DO l=1,nlevnc 1013 write(*,*)trim(modname)//' PL(',l,')=',&1013 WRITE(*,*)trim(modname)//' PL(',l,')=',& 1014 1014 apnc(l)+bpnc(l)*psnat2(1,jjbu) 1015 1015 ENDDO 1016 1016 CASE (2) 1017 1017 do l=1,nlevnc 1018 write(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l)1018 WRITE(*,*)trim(modname)//' PL(',l,')=',pnat2(1,jjbu,l) 1019 1019 enddo 1020 1020 END SELECT 1021 write(*,*)trim(modname)//' invert ordering: invert_p=',invert_p1022 if (guide_u) then1021 WRITE(*,*)trim(modname)//' invert ordering: invert_p=',invert_p 1022 if (guide_u) THEN 1023 1023 do l=1,nlevnc 1024 write(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l)1024 WRITE(*,*)trim(modname)//' U(',l,')=',unat2(1,jjbu,l) 1025 1025 enddo 1026 1026 endif 1027 if (guide_T) then1027 if (guide_T) THEN 1028 1028 do l=1,nlevnc 1029 write(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l)1029 WRITE(*,*)trim(modname)//' T(',l,')=',tnat2(1,jjbu,l) 1030 1030 enddo 1031 1031 endif … … 1034 1034 1035 1035 if (guide_plevs /= 1 .or. guide_t .and. .not. guide_teta & 1036 .or. guide_q .and. guide_hr) then1036 .or. guide_q .and. guide_hr) THEN 1037 1037 CALL pression_loc( ijnb_u, ap, bp, psi, p ) 1038 if (disvert_type==1) then1038 if (disvert_type==1) THEN 1039 1039 CALL exner_hyb_loc(ijnb_u,psi,p,pks,pk) 1040 1040 else ! we assume that we are in the disvert_type==2 case … … 1110 1110 ! Conversion en variables gcm (ucov, vcov...) 1111 1111 ! ----------------------------------------------------------------- 1112 if (guide_P) then1112 if (guide_P) THEN 1113 1113 !$OMP MASTER 1114 1114 do j=jjbu,jjeu … … 1177 1177 tgui2(j*iip1,l)=tgui2((j-1)*iip1+1,l) 1178 1178 enddo 1179 if (pole_nord) then1179 if (pole_nord) THEN 1180 1180 do i=1,iip1 1181 1181 tgui1(i,l)=tgui1(1,l) … … 1183 1183 enddo 1184 1184 endif 1185 if (pole_sud) then1185 if (pole_sud) THEN 1186 1186 do i=1,iip1 1187 1187 tgui1(ip1jm+i,l)=tgui1(ip1jm+1,l) … … 1239 1239 qgui2(j*iip1,l)=qgui2((j-1)*iip1+1,l) 1240 1240 enddo 1241 if (pole_nord) then1241 if (pole_nord) THEN 1242 1242 do i=1,iip1 1243 1243 qgui1(i,l)=qgui1(1,l) … … 1245 1245 enddo 1246 1246 endif 1247 if (pole_sud) then1247 if (pole_sud) THEN 1248 1248 do i=1,iip1 1249 1249 qgui1(ip1jm+i,l)=qgui1(ip1jm+1,l) … … 1317 1317 ugui2(j*iip1,l)=ugui2((j-1)*iip1+1,l) 1318 1318 enddo 1319 if (pole_nord) then1319 if (pole_nord) THEN 1320 1320 do i=1,iip1 1321 1321 ugui1(i,l)=0. … … 1323 1323 enddo 1324 1324 endif 1325 if (pole_sud) then1325 if (pole_sud) THEN 1326 1326 do i=1,iip1 1327 1327 ugui1(ip1jm+i,l)=0. … … 1403 1403 ! Calcul des constantes de rappel alpha (=1/tau) 1404 1404 1405 use comconst_mod, only: pi1406 use serre_mod, only: clat, clon, grossismx, grossismy1405 use comconst_mod, ONLY: pi 1406 use serre_mod, ONLY: clat, clon, grossismx, grossismy 1407 1407 1408 1408 IMPLICIT NONE … … 1431 1431 real alphamin,alphamax,xi 1432 1432 integer i,j,ilon,ilat 1433 character(len=20),parameter :: modname="tau2alpha"1433 CHARACTER(LEN=20),parameter :: modname="tau2alpha" 1434 1434 1435 1435 … … 1444 1444 do j=jjb,jje 1445 1445 do i=1,pim 1446 if (typ==2) then1446 if (typ==2) THEN 1447 1447 zlat=rlatu(j)*180./pi 1448 1448 zlon=rlonu(i)*180./pi 1449 elseif (typ==1) then1449 elseif (typ==1) THEN 1450 1450 zlat=rlatu(j)*180./pi 1451 1451 zlon=rlonv(i)*180./pi 1452 elseif (typ==3) then1452 elseif (typ==3) THEN 1453 1453 zlat=rlatv(j)*180./pi 1454 1454 zlon=rlonv(i)*180./pi … … 1519 1519 enddo 1520 1520 ! Calcul de gamma 1521 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) then1522 write(*,*)trim(modname)//' ATTENTION modele peu zoome'1523 write(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste'1521 if (abs(grossismx-1.)<0.1.or.abs(grossismy-1.)<0.1) THEN 1522 WRITE(*,*)trim(modname)//' ATTENTION modele peu zoome' 1523 WRITE(*,*)trim(modname)//' ATTENTION on prend une constante de guidage cste' 1524 1524 gamma=0. 1525 1525 else 1526 1526 gamma=(dxdy_max-2.*dxdy_min)/(dxdy_max-dxdy_min) 1527 write(*,*)trim(modname)//' gamma=',gamma1528 if (gamma<1.e-5) then1529 write(*,*)trim(modname)//' gamma =',gamma,'<1e-5'1527 WRITE(*,*)trim(modname)//' gamma=',gamma 1528 if (gamma<1.e-5) THEN 1529 WRITE(*,*)trim(modname)//' gamma =',gamma,'<1e-5' 1530 1530 CALL abort_gcm("guide_loc_mod","stopped",1) 1531 1531 endif 1532 1532 gamma=log(0.5)/log(gamma) 1533 if (gamma4) then1533 if (gamma4) THEN 1534 1534 gamma=min(gamma,4.) 1535 1535 endif 1536 write(*,*)trim(modname)//' gamma=',gamma1536 WRITE(*,*)trim(modname)//' gamma=',gamma 1537 1537 endif 1538 1538 ENDIF !first … … 1540 1540 do j=jjb,jje 1541 1541 do i=1,pim 1542 if (typ==1) then1542 if (typ==1) THEN 1543 1543 dxdy_=dxdys(i,j) 1544 1544 zlat=rlatu(j)*180./pi 1545 elseif (typ==2) then1545 elseif (typ==2) THEN 1546 1546 dxdy_=dxdyu(i,j) 1547 1547 zlat=rlatu(j)*180./pi 1548 elseif (typ==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.)<0.1.or.abs(grossismy-1.)<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<=zlat .and. zlat<=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 … … 1596 1596 ! Premier appel: initialisation de la lecture des fichiers 1597 1597 ! ----------------------------------------------------------------- 1598 if (first) then1598 if (first) THEN 1599 1599 ncidpl=-99 1600 write(*,*) trim(modname)//': opening nudging files '1600 WRITE(*,*) trim(modname)//': opening nudging files ' 1601 1601 ! Ap et Bp si Niveaux de pression hybrides 1602 if (guide_plevs==1) then1603 write(*,*) trim(modname)//' Reading nudging on model levels'1602 if (guide_plevs==1) THEN 1603 WRITE(*,*) trim(modname)//' Reading nudging on model levels' 1604 1604 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1605 1605 IF (rcode/=nf90_noerr) THEN … … 1617 1617 CALL abort_gcm(modname,abort_message,1) 1618 1618 ENDIF 1619 write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap1619 WRITE(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap 1620 1620 endif 1621 1621 1622 1622 ! Pression si guidage sur niveaux P variables 1623 if (guide_plevs==2) then1623 if (guide_plevs==2) THEN 1624 1624 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1625 1625 IF (rcode/=nf90_noerr) THEN … … 1632 1632 CALL abort_gcm(modname,abort_message,1) 1633 1633 ENDIF 1634 write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp1634 WRITE(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp 1635 1635 if (ncidpl==-99) ncidpl=ncidp 1636 1636 endif 1637 1637 1638 1638 ! Vent zonal 1639 if (guide_u) then1639 if (guide_u) THEN 1640 1640 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1641 1641 IF (rcode/=nf90_noerr) THEN … … 1648 1648 CALL abort_gcm(modname,abort_message,1) 1649 1649 ENDIF 1650 write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu1650 WRITE(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu 1651 1651 if (ncidpl==-99) ncidpl=ncidu 1652 1652 … … 1669 1669 1670 1670 ! Vent meridien 1671 if (guide_v) then1671 if (guide_v) THEN 1672 1672 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1673 1673 IF (rcode/=nf90_noerr) THEN … … 1680 1680 CALL abort_gcm(modname,abort_message,1) 1681 1681 ENDIF 1682 write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv1682 WRITE(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv 1683 1683 if (ncidpl==-99) ncidpl=ncidv 1684 1684 … … 1702 1702 1703 1703 ! Temperature 1704 if (guide_T) then1704 if (guide_T) THEN 1705 1705 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1706 1706 IF (rcode/=nf90_noerr) THEN … … 1713 1713 CALL abort_gcm(modname,abort_message,1) 1714 1714 ENDIF 1715 write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt1715 WRITE(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt 1716 1716 if (ncidpl==-99) ncidpl=ncidt 1717 1717 … … 1733 1733 1734 1734 ! Humidite 1735 if (guide_Q) then1735 if (guide_Q) THEN 1736 1736 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 1737 1737 IF (rcode/=nf90_noerr) THEN … … 1744 1744 CALL abort_gcm(modname,abort_message,1) 1745 1745 ENDIF 1746 write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ1746 WRITE(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1747 1747 if (ncidpl==-99) ncidpl=ncidQ 1748 1748 … … 1765 1765 endif 1766 1766 ! Pression de surface 1767 if ((guide_P).OR.(guide_plevs==1)) then1767 if ((guide_P).OR.(guide_plevs==1)) THEN 1768 1768 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 1769 1769 IF (rcode/=nf90_noerr) THEN … … 1776 1776 CALL abort_gcm(modname,abort_message,1) 1777 1777 ENDIF 1778 write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps1778 WRITE(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps 1779 1779 endif 1780 1780 ! Coordonnee verticale 1781 if (guide_plevs==0) then1781 if (guide_plevs==0) THEN 1782 1782 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1783 1783 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1784 write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl1784 WRITE(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1785 1785 endif 1786 1786 ! Coefs ap, bp pour calcul de la pression aux differents niveaux … … 1814 1814 IF (invert_y) start(2)=jjp1-jje_u+1 1815 1815 ! Pression 1816 if (guide_plevs==2) then1816 if (guide_plevs==2) THEN 1817 1817 status=nf90_put_var(ncidp,varidp,pnat2,start,count) 1818 1818 IF (invert_y) THEN … … 1824 1824 1825 1825 ! Vent zonal 1826 if (guide_u) then1826 if (guide_u) THEN 1827 1827 status=nf90_put_var(ncidu,varidu,unat2,start,count) 1828 1828 IF (invert_y) THEN … … 1836 1836 1837 1837 ! Temperature 1838 if (guide_T) then1838 if (guide_T) THEN 1839 1839 status=nf90_put_var(ncidt,varidt,tnat2,start,count) 1840 1840 IF (invert_y) THEN … … 1846 1846 1847 1847 ! Humidite 1848 if (guide_Q) then1848 if (guide_Q) THEN 1849 1849 status=nf90_put_var(ncidQ,varidQ,qnat2,start,count) 1850 1850 IF (invert_y) THEN … … 1857 1857 1858 1858 ! Vent meridien 1859 if (guide_v) then1859 if (guide_v) THEN 1860 1860 start(2)=jjb_v 1861 1861 count(2)=jjnb_v … … 1871 1871 1872 1872 ! Pression de surface 1873 if ((guide_P).OR.(guide_plevs==1)) then1873 if ((guide_P).OR.(guide_plevs==1)) THEN 1874 1874 start(2)=jjb_u 1875 1875 start(3)=timestep … … 1918 1918 ! Premier appel: initialisation de la lecture des fichiers 1919 1919 ! ----------------------------------------------------------------- 1920 if (first) then1920 if (first) THEN 1921 1921 ncidpl=-99 1922 write(*,*)trim(modname)//' : opening nudging files '1922 WRITE(*,*)trim(modname)//' : opening nudging files ' 1923 1923 ! Ap et Bp si niveaux de pression hybrides 1924 if (guide_plevs==1) then1925 write(*,*)trim(modname)//' Reading nudging on model levels'1924 if (guide_plevs==1) THEN 1925 WRITE(*,*)trim(modname)//' Reading nudging on model levels' 1926 1926 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1927 1927 IF (rcode/=nf90_noerr) THEN … … 1939 1939 CALL abort_gcm(modname,abort_message,1) 1940 1940 ENDIF 1941 write(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap1941 WRITE(*,*)trim(modname)//'ncidpl,varidap',ncidpl,varidap 1942 1942 endif 1943 1943 ! Pression 1944 if (guide_plevs==2) then1944 if (guide_plevs==2) THEN 1945 1945 rcode = nf90_open('P.nc', nf90_nowrite, ncidp) 1946 1946 IF (rcode/=nf90_noerr) THEN … … 1953 1953 CALL abort_gcm(modname,abort_message,1) 1954 1954 ENDIF 1955 write(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp1955 WRITE(*,*)trim(modname)//' ncidp,varidp',ncidp,varidp 1956 1956 if (ncidpl==-99) ncidpl=ncidp 1957 1957 endif 1958 1958 ! Vent zonal 1959 if (guide_u) then1959 if (guide_u) THEN 1960 1960 rcode = nf90_open('u.nc', nf90_nowrite, ncidu) 1961 1961 IF (rcode/=nf90_noerr) THEN … … 1968 1968 CALL abort_gcm(modname,abort_message,1) 1969 1969 ENDIF 1970 write(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu1970 WRITE(*,*)trim(modname)//' ncidu,varidu',ncidu,varidu 1971 1971 if (ncidpl==-99) ncidpl=ncidu 1972 1972 endif 1973 1973 1974 1974 ! Vent meridien 1975 if (guide_v) then1975 if (guide_v) THEN 1976 1976 rcode = nf90_open('v.nc', nf90_nowrite, ncidv) 1977 1977 IF (rcode/=nf90_noerr) THEN … … 1984 1984 CALL abort_gcm(modname,abort_message,1) 1985 1985 ENDIF 1986 write(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv1986 WRITE(*,*)trim(modname)//' ncidv,varidv',ncidv,varidv 1987 1987 if (ncidpl==-99) ncidpl=ncidv 1988 1988 endif 1989 1989 ! Temperature 1990 if (guide_T) then1990 if (guide_T) THEN 1991 1991 rcode = nf90_open('T.nc', nf90_nowrite, ncidt) 1992 1992 IF (rcode/=nf90_noerr) THEN … … 1999 1999 CALL abort_gcm(modname,abort_message,1) 2000 2000 ENDIF 2001 write(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt2001 WRITE(*,*)trim(modname)//' ncidT,varidT',ncidt,varidt 2002 2002 if (ncidpl==-99) ncidpl=ncidt 2003 2003 endif 2004 2004 ! Humidite 2005 if (guide_Q) then2005 if (guide_Q) THEN 2006 2006 rcode = nf90_open('hur.nc', nf90_nowrite, ncidQ) 2007 2007 IF (rcode/=nf90_noerr) THEN … … 2014 2014 CALL abort_gcm(modname,abort_message,1) 2015 2015 ENDIF 2016 write(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ2016 WRITE(*,*)trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 2017 2017 if (ncidpl==-99) ncidpl=ncidQ 2018 2018 endif 2019 2019 ! Pression de surface 2020 if ((guide_P).OR.(guide_plevs==1)) then2020 if ((guide_P).OR.(guide_plevs==1)) THEN 2021 2021 rcode = nf90_open('ps.nc', nf90_nowrite, ncidps) 2022 2022 IF (rcode/=nf90_noerr) THEN … … 2029 2029 CALL abort_gcm(modname,abort_message,1) 2030 2030 ENDIF 2031 write(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps2031 WRITE(*,*)trim(modname)//' ncidps,varidps',ncidps,varidps 2032 2032 endif 2033 2033 ! Coordonnee verticale 2034 if (guide_plevs==0) then2034 if (guide_plevs==0) THEN 2035 2035 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 2036 2036 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 2037 write(*,*)trim(modname)//' ncidpl,varidpl',ncidpl,varidpl2037 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==1) then2040 if (guide_plevs==1) THEN 2041 2041 status=nf90_put_var(ncidpl,varidap,apnc,[1],[nlevnc]) 2042 2042 status=nf90_put_var(ncidpl,varidbp,bpnc,[1],[nlevnc]) … … 2066 2066 IF (invert_y) start(2)=jjp1-jje_u+1 2067 2067 ! Pression 2068 if (guide_plevs==2) then2068 if (guide_plevs==2) THEN 2069 2069 status=nf90_put_var(ncidp,varidp,zu,start,count) 2070 2070 DO i=1,iip1 … … 2079 2079 endif 2080 2080 ! Vent zonal 2081 if (guide_u) then2081 if (guide_u) THEN 2082 2082 status=nf90_put_var(ncidu,varidu,zu,start,count) 2083 2083 DO i=1,iip1 … … 2094 2094 2095 2095 ! Temperature 2096 if (guide_T) then2096 if (guide_T) THEN 2097 2097 status=nf90_put_var(ncidt,varidt,zu,start,count) 2098 2098 DO i=1,iip1 … … 2108 2108 2109 2109 ! Humidite 2110 if (guide_Q) then2110 if (guide_Q) THEN 2111 2111 status=nf90_put_var(ncidQ,varidQ,zu,start,count) 2112 2112 DO i=1,iip1 … … 2122 2122 2123 2123 ! Vent meridien 2124 if (guide_v) then2124 if (guide_v) THEN 2125 2125 start(2)=jjb_v 2126 2126 count(2)=jjnb_v … … 2140 2140 2141 2141 ! Pression de surface 2142 if ((guide_P).OR.(guide_plevs==1)) then2142 if ((guide_P).OR.(guide_plevs==1)) THEN 2143 2143 start(2)=jjb_u 2144 2144 start(3)=timestep … … 2168 2168 USE comconst_mod, ONLY: pi 2169 2169 USE comvert_mod, ONLY: presnivs 2170 use netcdf95, only: nf95_def_var, nf95_put_var2170 use netcdf95, ONLY: nf95_def_var, nf95_put_var 2171 2171 2172 2172 IMPLICIT NONE … … 2201 2201 !$OMP BARRIER 2202 2202 2203 ! write(*,*)trim(modname)//' after allocation ',hsize,vsize2203 ! WRITE(*,*)trim(modname)//' after allocation ',hsize,vsize 2204 2204 2205 2205 IF (hsize==jjp1) THEN … … 2209 2209 ENDIF 2210 2210 2211 ! write(*,*)trim(modname)//' after gather '2211 ! WRITE(*,*)trim(modname)//' after gather ' 2212 2212 CALL Gather_field_u(alpha_u,zu,1) 2213 2213 CALL Gather_field_u(alpha_t,zt,1) … … 2348 2348 END SELECT 2349 2349 2350 ! if (varname=="ua") then2350 ! if (varname=="ua") THEN 2351 2351 ! CALL dump2d(iip1,jjp1,field_glo,'ua gui1 1ere couche ') 2352 2352 ! CALL dump2d(iip1,jjp1,field_glo(:,:,llm),'ua gui1 llm ') … … 2374 2374 do l=1,nl 2375 2375 do i=2,iim-1 2376 if(abs(x(i,l))>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 … … 2409 2409 CALL barrier 2410 2410 2411 if (mpi_rank==0) then2411 if (mpi_rank==0) THEN 2412 2412 CALL dump2d(iip1,jjp1,var_glob,varname) 2413 2413 endif
Note: See TracChangeset
for help on using the changeset viewer.
