- Timestamp:
- Jul 24, 2024, 4:23:34 PM (4 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv30_routines.F90
r5116 r5117 191 191 REAL ph(len, nd+1) 192 192 #ifdef ISO 193 real xt(ntraciso,len,nd)193 REAL xt(ntraciso,len,nd) 194 194 #endif 195 195 … … 198 198 REAL tnk(len), qnk(len), gznk(len), plcl(len) 199 199 #ifdef ISO 200 real xtnk(ntraciso,len)200 REAL xtnk(ntraciso,len) 201 201 #endif 202 202 … … 204 204 INTEGER i, k 205 205 #ifdef ISO 206 integerixt206 INTEGER ixt 207 207 #endif 208 208 INTEGER ihmin(len) … … 225 225 ! @ do 200 k=2,nlp 226 226 ! @ do 190 i=1,len 227 ! @ if((hm(i,k).lt.work(i)). and.227 ! @ if((hm(i,k).lt.work(i)).AND. 228 228 ! @ & (hm(i,k).lt.hm(i,k-1)))THEN 229 229 ! @ work(i)=hm(i,k) … … 250 250 ! @ do 240 k=minorig+1,nl 251 251 ! @ do 230 i=1,len 252 ! @ if((hm(i,k).gt.work(i)). and.(k.le.ihmin(i)))THEN252 ! @ if((hm(i,k).gt.work(i)).AND.(k.le.ihmin(i)))THEN 253 253 ! @ work(i)=hm(i,k) 254 254 ! @ nk(i)=k … … 270 270 ! ------------------------------------------------------------------- 271 271 DO i = 1, len 272 IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0)) & ! @ & . or.(272 IF (((t(i,nk(i))<250.0) .OR. (q(i,nk(i))<=0.0)) & ! @ & .OR.( 273 273 ! p(i,ihmin(i)).lt.400.0 274 274 ! ) ) … … 320 320 ! @ do 290 k=minorig,nl 321 321 ! @ do 280 i=1,len 322 ! @ if((k.ge.(nk(i)+1)). and.(p(i,k).lt.plcl(i)))322 ! @ if((k.ge.(nk(i)+1)).AND.(p(i,k).lt.plcl(i))) 323 323 ! @ & icb(i)=min(icb(i),k) 324 324 ! @ 280 continue … … 326 326 ! @c 327 327 ! @ do 300 i=1,len 328 ! @ if((icb(i).ge.nlm). and.(iflag(i).eq.0))iflag(i)=9328 ! @ if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9 329 329 ! @ 300 continue 330 330 … … 343 343 344 344 DO i = 1, len 345 ! @ if((icb(i).ge.nlm). and.(iflag(i).eq.0))iflag(i)=9345 ! @ if((icb(i).ge.nlm).AND.(iflag(i).EQ.0))iflag(i)=9 346 346 IF ((icb(i)==nlm) .AND. (iflag(i)==0)) iflag(i) = 9 347 347 END DO … … 377 377 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac 378 378 #ifdef ISOVERIF 379 useisotopes_verif_mod, ONLY: iso_verif_traceur380 #endif 381 #endif 382 #ifdef ISOVERIF 383 useisotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &379 USE isotopes_verif_mod, ONLY: iso_verif_traceur 380 #endif 381 #endif 382 #ifdef ISOVERIF 383 USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, & 384 384 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, & 385 385 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & … … 414 414 REAL plcl(len) ! convect3 415 415 #ifdef ISO 416 realxt(ntraciso,len,nd)416 REAL xt(ntraciso,len,nd) 417 417 #endif 418 418 … … 420 420 REAL tp(len, nd), tvp(len, nd), clw(len, nd) 421 421 #ifdef ISO 422 real xtclw(ntraciso,len,nd)423 real tg_save(len,nd)422 REAL xtclw(ntraciso,len,nd) 423 REAL tg_save(len,nd) 424 424 #endif 425 425 … … 433 433 REAL cpinv(len) ! convect3 434 434 #ifdef ISO 435 integerixt436 realzfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len)437 realq_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len)435 INTEGER ixt 436 REAL zfice(len),zxtliq(ntraciso,len),zxtice(ntraciso,len) 437 REAL q_k(len),clw_k(len),tg_k(len),xt_k(ntraciso,len) 438 438 !#ifdef ISOVERIF 439 439 ! integer iso_verif_positif_nostop … … 618 618 'cv30_routines 654') 619 619 enddo 620 if(iso_HDO.gt.0) THEN620 IF (iso_HDO.gt.0) THEN 621 621 do i=1,len 622 if(qnk(i).gt.ridicule) THEN622 IF (qnk(i).gt.ridicule) THEN 623 623 CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), & 624 624 'cv30_routines 576') … … 649 649 WRITE(*,*) 'cv30_routine undilute 1 598: apres condiso' 650 650 651 if(iso_eau.gt.0) THEN651 IF (iso_eau.gt.0) THEN 652 652 do i=1,len 653 653 CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icbs(i)), & … … 785 785 #ifdef ISOVERIF 786 786 WRITE(*,*) 'cv30_routines 739: avant condiso' 787 if(iso_HDO.gt.0) THEN787 IF (iso_HDO.gt.0) THEN 788 788 do i=1,len 789 789 CALL iso_verif_aberrant(xt_k(iso_hdo,i)/qnk(i), & … … 815 815 !WRITE(*,*) 'DEBUG ISO B' 816 816 do i=1,len 817 if(iso_eau.gt.0) THEN817 IF (iso_eau.gt.0) THEN 818 818 CALL iso_verif_egalite_choix(xtclw(iso_eau,i,icb(i)+1), & 819 819 clw(i,icb(i)+1),'cv30_routines 708',errmax,errmaxrel) … … 897 897 ! oct3 ath = th(i,icb(i)-1) - dttrig 898 898 ! oct3 899 ! oct3 if (tdif.lt.dtcrit . or. ath.gt.ath1) THEN899 ! oct3 if (tdif.lt.dtcrit .OR. ath.gt.ath1) THEN 900 900 ! oct3 do 60 k=1,nl 901 901 ! oct3 sig(i,k) = beta*sig(i,k) - 2.*alpha*tdif*tdif … … 947 947 USE lmdz_print_control, ONLY: lunout 948 948 #ifdef ISO 949 useinfotrac_phy, ONLY: ntraciso=>ntiso950 useisotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO951 #ifdef ISOVERIF 952 useisotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, &949 USE infotrac_phy, ONLY: ntraciso=>ntiso 950 USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO 951 #ifdef ISOVERIF 952 USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif, & 953 953 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, & 954 954 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & … … 975 975 #ifdef ISO 976 976 !integer niso 977 realxt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd)978 realxtnk1(ntraciso,len)977 REAL xt1(ntraciso,len,nd), xtclw1(ntraciso,len,nd) 978 REAL xtnk1(ntraciso,len) 979 979 #endif 980 980 … … 992 992 REAL tra(nloc, nd, ntra) 993 993 #ifdef ISO 994 realxt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)995 realxtnk(ntraciso,nloc)994 REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd) 995 REAL xtnk(ntraciso,nloc) 996 996 #endif 997 997 … … 999 999 INTEGER i, k, nn, j 1000 1000 #ifdef ISO 1001 integerixt1001 INTEGER ixt 1002 1002 #endif 1003 1003 … … 1009 1009 do k=1,nd 1010 1010 do i=1,nloc 1011 if(essai_convergence) THEN1011 IF (essai_convergence) THEN 1012 1012 else 1013 1013 q(i,k)=0.0 … … 1063 1063 ! nn=0 1064 1064 ! do 101 i=1,len 1065 ! IF(iflag1(i). eq.0)THEN1065 ! IF(iflag1(i).EQ.0)THEN 1066 1066 ! nn=nn+1 1067 1067 ! tra(nn,k,j)=tra1(i,k,j) 1068 ! endif1068 ! END IF 1069 1069 ! 101 continue 1070 1070 ! 111 continue … … 1101 1101 #ifdef ISO 1102 1102 #ifdef ISOVERIF 1103 if(iso_eau.gt.0) THEN1103 IF (iso_eau.gt.0) THEN 1104 1104 do k = 1, nd 1105 1105 do i = 1, nloc … … 1133 1133 ! epmax_cape: ajout arguments 1134 1134 #ifdef ISO 1135 useinfotrac_phy, ONLY: ntraciso=>ntiso1135 USE infotrac_phy, ONLY: ntraciso=>ntiso 1136 1136 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax,cond_temp_env, iso_eau,iso_HDO 1137 1137 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall … … 1143 1143 #endif 1144 1144 #ifdef ISOVERIF 1145 useisotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,Tmax_verif, &1145 USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,Tmax_verif, & 1146 1146 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, & 1147 1147 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & … … 1197 1197 1198 1198 #ifdef ISO 1199 realxt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd)1200 realxtnk(ntraciso,nloc)1199 REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,nd) 1200 REAL xtnk(ntraciso,nloc) 1201 1201 ! real xtep(ntraciso,nloc,nd) ! le 7 mai: on supprime xtep, car pas besoin 1202 1202 ! la chute de precip ne fractionne pas. 1203 integerixt1204 realzfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)1205 realclw_k(nloc),tg_k(nloc)1203 INTEGER ixt 1204 REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc) 1205 REAL clw_k(nloc),tg_k(nloc) 1206 1206 #ifdef ISOVERIF 1207 realqg_save(nloc,nd) ! inout1207 REAL qg_save(nloc,nd) ! inout 1208 1208 !integer iso_verif_positif_nostop 1209 1209 #endif … … 1327 1327 #ifdef ISOVERIF 1328 1328 !WRITE(*,*) 'cv30_routine 1259: avant condiso' 1329 if(iso_HDO.gt.0) THEN1329 IF (iso_HDO.gt.0) THEN 1330 1330 do i=1,ncum 1331 1331 CALL iso_verif_aberrant(xtnk(iso_hdo,i)/qnk(i), & … … 1333 1333 enddo 1334 1334 endif !if (iso_HDO.gt.0) THEN 1335 if(iso_eau.gt.0) THEN1335 IF (iso_eau.gt.0) THEN 1336 1336 do i=1,ncum 1337 1337 CALL iso_verif_egalite(xtnk(iso_eau,i),qnk(i), & … … 1340 1340 endif !if (iso_HDO.gt.0) THEN 1341 1341 do i=1,ncum 1342 if((iso_verif_positif_nostop(qnk(i)-clw_k(i), &1343 'cv30_routines 1275'). eq.1).or. &1342 IF ((iso_verif_positif_nostop(qnk(i)-clw_k(i), & 1343 'cv30_routines 1275').EQ.1).OR. & 1344 1344 (iso_verif_positif_nostop(tg_k(i)-Tmin_verif, & 1345 'cv30_routines 1297a'). eq.1).or. &1345 'cv30_routines 1297a').EQ.1).OR. & 1346 1346 (iso_verif_positif_nostop(Tmax_verif-tg_k(i), & 1347 'cv30_routines 1297b'). eq.1)) THEN1347 'cv30_routines 1297b').EQ.1)) THEN 1348 1348 WRITE(*,*) 'i,k,qnk,clw_k=',i,k,qnk(i),clw_k(i) 1349 1349 WRITE(*,*) 'tg,t,qg=',tg_k(i),t(i,k),qg_save(i,k) … … 1376 1376 enddo !do i=1,ncum 1377 1377 #ifdef ISOVERIF 1378 if(iso_eau.gt.0) THEN1378 IF (iso_eau.gt.0) THEN 1379 1379 do i=1,ncum 1380 1380 CALL iso_verif_egalite_choix(xtclw(iso_eau,i,k), & … … 1516 1516 ! inb(i)=k+1 1517 1517 ! capem(i)=cape(i) 1518 ! endif1519 ! endif1518 ! END IF 1519 ! END IF 1520 1520 ! 520 continue 1521 1521 ! 530 continue … … 1543 1543 ! capem(i)=cape(i) 1544 1544 ! byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1) 1545 ! endif1546 ! endif1545 ! END IF 1546 ! END IF 1547 1547 ! 520 continue 1548 1548 ! 530 continue … … 1566 1566 ! ori do 520 i=1,ncum 1567 1567 ! ori IF(cape(i).lt.0.0)lcape(i)=.FALSE. 1568 ! ori if((k.ge.(icb(i)+1)). and.lcape(i))THEN1568 ! ori if((k.ge.(icb(i)+1)).AND.lcape(i))THEN 1569 1569 ! ori by=(tvp(i,k)-tv(i,k))*dph(i,k)/p(i,k) 1570 1570 ! ori byp(i)=(tvp(i,k+1)-tv(i,k+1))*dph(i,k+1)/p(i,k+1) … … 1828 1828 1829 1829 #ifdef ISO 1830 useinfotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso1830 USE infotrac_phy, ONLY: ntraciso=>ntiso,niso,itZonIso 1831 1831 USE isotopes_mod, ONLY: pxtmelt,pxtice,pxtmin,pxtmax, iso_eau,iso_HDO, & 1832 1832 ridicule 1833 1833 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall 1834 1834 #ifdef ISOVERIF 1835 useisotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, &1835 USE isotopes_verif_mod, ONLY: errmax,errmaxrel,Tmin_verif,deltalim, & 1836 1836 iso_verif_egalite_choix,iso_verif_aberrant_choix, iso_verif_noNaN, & 1837 1837 iso_verif_aberrant, & … … 1841 1841 #endif 1842 1842 #ifdef ISOTRAC 1843 useisotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, &1843 USE isotrac_mod, ONLY: option_tmin,option_traceurs,seuil_tag_tmin, & 1844 1844 & option_cond,index_zone,izone_cond,index_iso 1845 useisotrac_routines_mod, ONLY: iso_recolorise_condensation1846 useisotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac1847 #ifdef ISOVERIF 1848 useisotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, &1845 USE isotrac_routines_mod, ONLY: iso_recolorise_condensation 1846 USE isotopes_routines_mod, ONLY: condiso_liq_ice_vectall_trac 1847 #ifdef ISOVERIF 1848 USE isotopes_verif_mod, ONLY: iso_verif_trac17_q_deltad,iso_verif_traceur, & 1849 1849 & iso_verif_traceur_justmass 1850 1850 #endif … … 1875 1875 REAL m(nloc, na) ! input of convect3 1876 1876 #ifdef ISO 1877 realxt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na)1878 realtg_save(nloc,nd)1879 realxtnk(ntraciso,nloc)1877 REAL xt(ntraciso,nloc,na), xtclw(ntraciso,nloc,na) 1878 REAL tg_save(nloc,nd) 1879 REAL xtnk(ntraciso,nloc) 1880 1880 ! real xtep(ntraciso,nloc,na) 1881 1881 #endif … … 1889 1889 REAL sigij(nloc, nd, nd) 1890 1890 #ifdef ISO 1891 realxtent(ntraciso,nloc,nd,nd)1892 real xtelij(ntraciso,nloc,nd,nd)1891 REAL xtent(ntraciso,nloc,nd,nd) 1892 REAL xtelij(ntraciso,nloc,nd,nd) 1893 1893 #endif 1894 1894 … … 1905 1905 LOGICAL lwork(nloc) 1906 1906 #ifdef ISO 1907 integerixt1908 realxtrti(ntraciso,nloc)1909 realxtres(ntraciso)1907 INTEGER ixt 1908 REAL xtrti(ntraciso,nloc) 1909 REAL xtres(ntraciso) 1910 1910 ! on ajoute la dimension nloc a xtrti pour verifs dans les tags: 5 fev 1911 1911 ! 2010 1912 realzfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc)1912 REAL zfice(nloc),zxtliq(ntraciso,nloc),zxtice(ntraciso,nloc) 1913 1913 ! real xt_reduit(ntraciso) 1914 ! logicalnegation1914 ! LOGICAL negation 1915 1915 !#ifdef ISOVERIF 1916 1916 ! integer iso_verif_positif_nostop … … 1924 1924 #ifdef ISOVERIF 1925 1925 WRITE(*,*) 'cv30_routines 1820: entree dans cv3_mixing' 1926 if(iso_eau.gt.0) THEN1926 IF (iso_eau.gt.0) THEN 1927 1927 CALL iso_verif_egalite_vect2D( & 1928 1928 xtclw,clw, & … … 2051 2051 zfice(il) = 1.0-(t(il,j)-pxtice)/(pxtmelt-pxtice) 2052 2052 zfice(il) = MIN(MAX(zfice(il),0.0),1.0) 2053 IF( (i.ge.icb(il)). and.(i.le.inb(il)).and. &2054 (j.ge.(icb(il)-1)). and.(j.le.inb(il)))THEN2053 IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. & 2054 (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN 2055 2055 do ixt=1,ntraciso 2056 2056 ! xtrti(ixt)=xt(ixt,il,1)-xtep(ixt,il,i)*xtclw(ixt,il,i) ! le 7 mai: on supprime xtep 2057 2057 xtrti(ixt,il)=xt(ixt,il,1)-ep(il,i)*xtclw(ixt,il,i) 2058 2058 enddo 2059 IF(sij(il,i,j).gt.0.0. and.sij(il,i,j).lt.0.95)THEN2059 IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN 2060 2060 ! temperature of condensation (within mixtures): 2061 2061 ! tcond(il)=t(il,j) … … 2069 2069 +(1.-sij(il,i,j))*xtrti(ixt,il) 2070 2070 enddo !do ixt = 1, ntraciso 2071 endif !IF(sij(il,i,j).gt.0.0. and.sij(il,i,j).lt.0.95)THEN2072 endif !IF( (i.ge.icb(il)). and.(i.le.inb(il)).and.2071 endif !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN 2072 endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. 2073 2073 enddo !do il=1,ncum 2074 2074 … … 2083 2083 do il=1,ncum 2084 2084 CALL iso_verif_traceur(xt(1,il,i),'cv30_routines 1967') 2085 IF( (i.ge.icb(il)). and.(i.le.inb(il)).and. &2086 (j.ge.(icb(il)-1)). and.(j.le.inb(il)))THEN2085 IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. & 2086 (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN 2087 2087 CALL iso_verif_traceur(xtrti(1,il),'cv30_routines 1968') 2088 endif !IF( (i.ge.icb(il)). and.(i.le.inb(il)).and.2088 endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. 2089 2089 CALL iso_verif_traceur(xtent(1,il,i,j),'cv30_routines 1969') 2090 2090 … … 2099 2099 2100 2100 #ifdef ISOVERIF 2101 if ((j.eq.15).and.(i.eq.15)) THEN2101 IF ((j.EQ.15).AND.(i.EQ.15)) THEN 2102 2102 il=2722 2103 if(il.le.ncum) THEN2103 IF (il.le.ncum) THEN 2104 2104 WRITE(*,*) 'cv30_routines tmp 2194, il,i,j=',il,i,j 2105 2105 WRITE(*,*) 'qent,elij=',qent(il,i,j),elij(il,i,j) … … 2116 2116 ! WRITE(*,*) 'cv30_routines tmp 1987,option_traceurs=', 2117 2117 ! : option_traceurs 2118 if(option_tmin.ge.1) THEN2118 IF (option_tmin.ge.1) THEN 2119 2119 do il=1,ncum 2120 2120 ! WRITE(*,*) 'cv3 tmp 1991 il,i,j,xtent(:,il,i,j),', … … 2123 2123 ! colorier la vapeur residuelle selon temperature de 2124 2124 ! condensation, et le condensat en un tag spEcifique 2125 if ((elij(il,i,j).gt.0.0).and.(qent(il,i,j).gt.0.0)) THEN2126 if (option_traceurs.eq.17) THEN2125 IF ((elij(il,i,j).gt.0.0).AND.(qent(il,i,j).gt.0.0)) THEN 2126 IF (option_traceurs.EQ.17) THEN 2127 2127 CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), & 2128 2128 xtent(1,il,i,j),xtelij(1,il,i,j),t(1,j), & 2129 2129 0.0,xtres, & 2130 2130 seuil_tag_tmin) 2131 else !if (option_traceurs. eq.17) THEN2131 else !if (option_traceurs.EQ.17) THEN 2132 2132 ! WRITE(*,*) 'cv3 2002: il,i,j =',il,i,j 2133 2133 CALL iso_recolorise_condensation(qent(il,i,j),elij(il,i,j), & 2134 2134 xtent(1,il,i,j),xtelij(1,il,i,j),rs(il,j),0.0,xtres, & 2135 2135 seuil_tag_tmin) 2136 endif !if (option_traceurs. eq.17) THEN2136 endif !if (option_traceurs.EQ.17) THEN 2137 2137 do ixt=1+niso,ntraciso 2138 2138 xtent(ixt,il,i,j)=xtres(ixt) … … 2155 2155 ! WRITE(*,*) 'cv30_routines 2050: avant condiso' 2156 2156 do il=1,ncum 2157 if ((i.ge.icb(il)).and.(i.le.inb(il)).and. &2158 (j.ge.(icb(il)-1)). and.(j.le.inb(il))) THEN2159 if (sij(il,i,j).gt.0.0.and.sij(il,i,j).lt.0.95) THEN2160 if(iso_eau.gt.0) THEN2157 IF ((i.ge.icb(il)).AND.(i.le.inb(il)).AND. & 2158 (j.ge.(icb(il)-1)).AND.(j.le.inb(il))) THEN 2159 IF (sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95) THEN 2160 IF (iso_eau.gt.0) THEN 2161 2161 CALL iso_verif_egalite_choix(xtent(iso_eau,il,i,j), & 2162 2162 qent(il,i,j),'cv30_routines 1889',errmax,errmaxrel) … … 2164 2164 elij(il,i,j),'cv30_routines 1890',errmax,errmaxrel) 2165 2165 endif 2166 if(iso_HDO.gt.0) THEN2166 IF (iso_HDO.gt.0) THEN 2167 2167 CALL iso_verif_aberrant_choix(xt(iso_HDO,il,i),rr(il,i), & 2168 2168 ridicule,deltalim,'cv30_routines 1997') … … 2182 2182 #endif 2183 2183 2184 endif !IF(sij(il,i,j).gt.0.0. and.sij(il,i,j).lt.0.95)THEN2185 endif !IF( (i.ge.icb(il)). and.(i.le.inb(il)).and.2184 endif !IF(sij(il,i,j).gt.0.0.AND.sij(il,i,j).lt.0.95)THEN 2185 endif !IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. 2186 2186 enddo !do il=1,ncum 2187 2187 #endif … … 2196 2196 ! do j=minorig,nl 2197 2197 ! do il=1,ncum 2198 ! IF( (i.ge.icb(il)). and.(i.le.inb(il)).and.2199 ! : (j.ge.(icb(il)-1)). and.(j.le.inb(il)))THEN2198 ! IF( (i.ge.icb(il)).AND.(i.le.inb(il)).AND. 2199 ! : (j.ge.(icb(il)-1)).AND.(j.le.inb(il)))THEN 2200 2200 ! traent(il,i,j,k)=sij(il,i,j)*tra(il,i,k) 2201 2201 ! : +(1.-sij(il,i,j))*tra(il,nk(il),k) 2202 ! endif2202 ! END IF 2203 2203 ! enddo 2204 2204 ! enddo … … 2216 2216 DO il = 1, ncum 2217 2217 IF ((i>=icb(il)) .AND. (i<=inb(il)) .AND. (nent(il,i)==0)) THEN 2218 ! @ IF(nent(il,i). eq.0)THEN2218 ! @ IF(nent(il,i).EQ.0)THEN 2219 2219 ment(il, i, i) = m(il, i) 2220 2220 qent(il, i, i) = rr(il, nk(il)) - ep(il, i)*clw(il, i) … … 2233 2233 2234 2234 #ifdef ISOVERIF 2235 if(iso_eau.gt.0) THEN2235 IF (iso_eau.gt.0) THEN 2236 2236 CALL iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), & 2237 2237 elij(il,i,i),'cv30_mixing 2117',errmax,errmaxrel) … … 2240 2240 2241 2241 #ifdef ISOTRAC 2242 if(option_tmin.ge.1) THEN2242 IF (option_tmin.ge.1) THEN 2243 2243 ! colorier la vapeur residuelle selon temperature de 2244 2244 ! condensation, et le condensat en un tag specifique 2245 2245 ! WRITE(*,*) 'cv3 tmp 2095 il,i,j,xtent(:,il,i,j)=', 2246 2246 ! : il,i,j,xtent(:,il,i,j) 2247 if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN2248 if (option_traceurs.eq.17) THEN2247 IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN 2248 IF (option_traceurs.EQ.17) THEN 2249 2249 CALL iso_recolorise_condensation(qent(il,i,i), & 2250 2250 elij(il,i,i), & … … 2252 2252 xtres, & 2253 2253 seuil_tag_tmin) 2254 else !if (option_traceurs. eq.17) THEN2254 else !if (option_traceurs.EQ.17) THEN 2255 2255 CALL iso_recolorise_condensation(qent(il,i,i), & 2256 2256 elij(il,i,i), & … … 2258 2258 xtres, & 2259 2259 seuil_tag_tmin) 2260 endif !if (option_traceurs. eq.17) THEN2260 endif !if (option_traceurs.EQ.17) THEN 2261 2261 do ixt=1+niso,ntraciso 2262 2262 xtent(ixt,il,i,i)=xtres(ixt) … … 2288 2288 ! do i=minorig+1,nl 2289 2289 ! do il=1,ncum 2290 ! if (i.ge.icb(il) . and. i.le.inb(il) .and. nent(il,i).eq.0) THEN2290 ! if (i.ge.icb(il) .AND. i.le.inb(il) .AND. nent(il,i).EQ.0) THEN 2291 2291 ! traent(il,i,i,j)=tra(il,nk(il),j) 2292 ! endif2292 ! END IF 2293 2293 ! enddo 2294 2294 ! enddo … … 2466 2466 2467 2467 #ifdef ISOVERIF 2468 if(iso_eau.gt.0) THEN2468 IF (iso_eau.gt.0) THEN 2469 2469 CALL iso_verif_egalite_choix(xtelij(iso_eau,il,i,i), & 2470 2470 elij(il,i,i),'cv30_mixing 2354',errmax,errmaxrel) … … 2473 2473 2474 2474 #ifdef ISOTRAC 2475 if(option_tmin.ge.1) THEN2475 IF (option_tmin.ge.1) THEN 2476 2476 ! colorier la vapeur residuelle selon temperature de 2477 2477 ! condensation, et le condensat en un tag specifique 2478 2478 ! WRITE(*,*) 'cv3 tmp 2314 il,i,j,xtent(:,il,i,j)=', 2479 2479 ! : il,i,j,xtent(:,il,i,j) 2480 if ((elij(il,i,i).gt.0.0).and.(qent(il,i,i).gt.0.0)) THEN2481 if (option_traceurs.eq.17) THEN2480 IF ((elij(il,i,i).gt.0.0).AND.(qent(il,i,i).gt.0.0)) THEN 2481 IF (option_traceurs.EQ.17) THEN 2482 2482 CALL iso_recolorise_condensation(qent(il,i,i), & 2483 2483 elij(il,i,i), & … … 2485 2485 xtres, & 2486 2486 seuil_tag_tmin) 2487 else !if (option_traceurs. eq.17) THEN2487 else !if (option_traceurs.EQ.17) THEN 2488 2488 CALL iso_recolorise_condensation(qent(il,i,i), & 2489 2489 elij(il,i,i), & … … 2491 2491 xtres, & 2492 2492 seuil_tag_tmin) 2493 endif ! if (option_traceurs. eq.17) THEN2493 endif ! if (option_traceurs.EQ.17) THEN 2494 2494 do ixt=1+niso,ntraciso 2495 2495 xtent(ixt,il,i,i)=xtres(ixt) … … 2517 2517 ! do j=1,ntra 2518 2518 ! do il=1,ncum 2519 ! if ( i.ge.icb(il) . and. i.le.inb(il) .and. lwork(il)2520 ! : . and. csum(il,i).lt.m(il,i) ) THEN2519 ! if ( i.ge.icb(il) .AND. i.le.inb(il) .AND. lwork(il) 2520 ! : .AND. csum(il,i).lt.m(il,i) ) THEN 2521 2521 ! traent(il,i,i,j)=tra(il,nk(il),j) 2522 ! endif2522 ! END IF 2523 2523 ! enddo 2524 2524 ! enddo … … 2560 2560 do jm = 1, nd 2561 2561 do il = 1, ncum 2562 if(iso_eau.gt.0) THEN2562 IF (iso_eau.gt.0) THEN 2563 2563 CALL iso_verif_egalite_choix(xtelij(iso_eau,il,im,jm), & 2564 2564 elij(il,im,jm),'cv30_mixing 2110',errmax,errmaxrel) … … 2579 2579 #ifdef ISOTRAC 2580 2580 ! seulement a la fin on taggue le condensat 2581 if(option_cond.ge.1) THEN2581 IF (option_cond.ge.1) THEN 2582 2582 do im = 1, nd 2583 2583 do jm = 1, nd … … 2585 2585 ! colorier le condensat en un tag specifique 2586 2586 do ixt=niso+1,ntraciso 2587 if (index_zone(ixt).eq.izone_cond) THEN2587 IF (index_zone(ixt).EQ.izone_cond) THEN 2588 2588 xtelij(ixt,il,im,jm)=xtelij(index_iso(ixt),il,im,jm) 2589 else !if (index_zone(ixt). eq.izone_cond) THEN2589 else !if (index_zone(ixt).EQ.izone_cond) THEN 2590 2590 xtelij(ixt,il,im,jm)=0.0 2591 endif !if (index_zone(ixt). eq.izone_cond) THEN2591 endif !if (index_zone(ixt).EQ.izone_cond) THEN 2592 2592 enddo !do ixt=1,ntraciso 2593 2593 #ifdef ISOVERIF … … 2604 2604 ! colorier le condensat en un tag specifique 2605 2605 do ixt=niso+1,ntraciso 2606 if (index_zone(ixt).eq.izone_cond) THEN2606 IF (index_zone(ixt).EQ.izone_cond) THEN 2607 2607 xtclw(ixt,il,im)=xtclw(index_iso(ixt),il,im) 2608 else !if (index_zone(ixt). eq.izone_cond) THEN2608 else !if (index_zone(ixt).EQ.izone_cond) THEN 2609 2609 xtclw(ixt,il,im)=0.0 2610 endif !if (index_zone(ixt). eq.izone_cond) THEN2610 endif !if (index_zone(ixt).EQ.izone_cond) THEN 2611 2611 enddo !do ixt=1,ntraciso 2612 2612 #ifdef ISOVERIF … … 2615 2615 CALL iso_verif_traceur(xtclw(1,il,im), & 2616 2616 'condiso_liq_ice_vectiso_trac 358') 2617 if(iso_verif_positif_nostop(xtclw(itZonIso( &2617 IF (iso_verif_positif_nostop(xtclw(itZonIso( & 2618 2618 izone_cond,iso_eau),i,k)-xtclw(iso_eau,i,k) & 2619 ,'cv30_routines 909'). eq.1) THEN2619 ,'cv30_routines 909').EQ.1) THEN 2620 2620 WRITE(*,*) 'i,k=',i,k 2621 2621 WRITE(*,*) 'xtclw=',xtclw(:,i,k) … … 2628 2628 enddo !do im = 1, nd 2629 2629 ! WRITE(*,*) 'xtclw(:,1,2)=',xtclw(:,1,2) 2630 endif !if (option_tmin. eq.1) THEN2630 endif !if (option_tmin.EQ.1) THEN 2631 2631 #endif 2632 2632 #endif … … 2646 2646 ) 2647 2647 #ifdef ISO 2648 useinfotrac_phy, ONLY: ntraciso=>ntiso, niso2649 useisotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule2650 useisotopes_routines_mod, ONLY: appel_stewart_vectall,appel_stewart_debug2651 #ifdef ISOVERIF 2652 useisotopes_verif_mod, ONLY: errmax,errmaxrel, &2648 USE infotrac_phy, ONLY: ntraciso=>ntiso, niso 2649 USE isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO,ridicule 2650 USE isotopes_routines_mod, ONLY: appel_stewart_vectall,appel_stewart_debug 2651 #ifdef ISOVERIF 2652 USE isotopes_verif_mod, ONLY: errmax,errmaxrel, & 2653 2653 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, & 2654 2654 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & … … 2657 2657 #endif 2658 2658 #ifdef ISOTRAC 2659 useisotrac_mod, ONLY: option_cond,izone_cond2660 useinfotrac_phy, ONLY: itZonIso2661 #ifdef ISOVERIF 2662 useisotopes_verif_mod, ONLY: iso_verif_traceur_justmass, &2659 USE isotrac_mod, ONLY: option_cond,izone_cond 2660 USE infotrac_phy, ONLY: itZonIso 2661 #ifdef ISOVERIF 2662 USE isotopes_verif_mod, ONLY: iso_verif_traceur_justmass, & 2663 2663 & iso_verif_traceur 2664 useisotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille2664 USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille 2665 2665 #endif 2666 2666 #endif … … 2687 2687 REAL m(nloc, na), ment(nloc, na, na), elij(nloc, na, na) 2688 2688 #ifdef ISO 2689 realxt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,na)2690 realxtelij(ntraciso,nloc,na,na)2689 REAL xt(ntraciso,nloc,nd), xtclw(ntraciso,nloc,na) 2690 REAL xtelij(ntraciso,nloc,na,na) 2691 2691 ! real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep 2692 2692 #endif … … 2704 2704 2705 2705 #ifdef ISO 2706 realxtp(ntraciso,nloc,na)2707 realxtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)2708 realxtwdtraina(ntraciso,nloc,na)2706 REAL xtp(ntraciso,nloc,na) 2707 REAL xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na) 2708 REAL xtwdtraina(ntraciso,nloc,na) 2709 2709 #endif 2710 2710 … … 2721 2721 2722 2722 #ifdef ISO 2723 integerixt2724 realxtawat(ntraciso)2723 INTEGER ixt 2724 REAL xtawat(ntraciso) 2725 2725 REAL xtwdtrain(ntraciso,nloc) 2726 ! logicalnegation2727 realrpprec(nloc,na)2726 ! LOGICAL negation 2727 REAL rpprec(nloc,na) 2728 2728 !#ifdef ISOVERIF 2729 2729 ! integer iso_verif_aberrant_nostop … … 2852 2852 !--debug: 2853 2853 #ifdef ISOVERIF 2854 if(iso_eau.gt.0) THEN2854 IF (iso_eau.gt.0) THEN 2855 2855 CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), & 2856 2856 wdtrain(il),'cv30_routines 2313',errmax,errmaxrel) … … 2886 2886 #ifdef ISO 2887 2887 ! precip mixed drafts computed from: xtawat/xtelij = awat/elij 2888 if (elij(il,j,i).ne.0.0) THEN2888 IF (elij(il,j,i).NE.0.0) THEN 2889 2889 do ixt=1,ntraciso 2890 2890 xtawat(ixt)=xtelij(ixt,il,j,i)*(awat/elij(il,j,i)) … … 2899 2899 2900 2900 #ifdef ISOVERIF 2901 if(iso_eau.gt.0) THEN2901 IF (iso_eau.gt.0) THEN 2902 2902 CALL iso_verif_egalite_choix(xtawat(iso_eau), & 2903 2903 awat,'cv30_routines 2391',errmax,errmaxrel) … … 2928 2928 !--debug: 2929 2929 #ifdef ISOVERIF 2930 if(iso_eau.gt.0) THEN2930 IF (iso_eau.gt.0) THEN 2931 2931 CALL iso_verif_egalite_choix(xtwdtrain(iso_eau,il), & 2932 2932 wdtrain(il),'cv30_routines 2366',errmax,errmaxrel) … … 2934 2934 #ifdef ISOTRAC 2935 2935 CALL iso_verif_traceur(xtwdtrain(1,il),'cv30_routine 2540') 2936 if(option_cond.ge.1) THEN2936 IF (option_cond.ge.1) THEN 2937 2937 ! on verifie que tout le detrainement est tagge condensat 2938 if(iso_verif_positif_nostop( &2938 IF (iso_verif_positif_nostop( & 2939 2939 xtwdtrain(itZonIso(izone_cond,iso_eau),il) & 2940 2940 -xtwdtrain(iso_eau,il), & 2941 'cv30_routines 2795'). eq.1) THEN2941 'cv30_routines 2795').EQ.1) THEN 2942 2942 WRITE(*,*) 'xtwdtrain(:,il)=',xtwdtrain(:,il) 2943 2943 WRITE(*,*) 'xtelij(:,il,j,i)=',xtelij(:,il,j,i) … … 3121 3121 END IF 3122 3122 3123 END IF ! i. eq.13123 END IF ! i.EQ.1 3124 3124 3125 3125 ! *** find mixing ratio of precipitating downdraft *** … … 3191 3191 ! WRITE(*,*) 'cv30_routines 2842 tmp: appel de appel_stewart' 3192 3192 do il=1,ncum 3193 if (i.le.inb(il) .and. lwork(il)) THEN3194 if(iso_eau.gt.0) THEN3193 IF (i.le.inb(il) .AND. lwork(il)) THEN 3194 IF (iso_eau.gt.0) THEN 3195 3195 CALL iso_verif_egalite_choix(xt(iso_eau,il,i), & 3196 3196 rr(il,i),'appel_stewart 262, cas 1.1',errmax,errmaxrel) … … 3208 3208 #endif 3209 3209 3210 if (1.eq.0) THEN3210 IF (1.EQ.0) THEN 3211 3211 ! appel de appel_stewart_vectorise 3212 3212 CALL appel_stewart_vectall(lwork,ncum, & … … 3220 3220 na,nd,nloc,cvflag_grav,ginv,1e-16) 3221 3221 3222 else !if (1. eq.0) THEN3222 else !if (1.EQ.0) THEN 3223 3223 ! truc simple sans fractionnement 3224 3224 ! juste pour debuggage … … 3226 3226 evap,water,rpprec,rr,wdtrain, & 3227 3227 xtevap,xtwater,xtp,xt,xtwdtrain) 3228 endif ! if (1. eq.0) THEN3228 endif ! if (1.EQ.0) THEN 3229 3229 #ifdef ISOVERIF 3230 3230 ! WRITE(*,*) 'cv30_routines 2864 tmp: sortie de appel_stewart' 3231 3231 ! verif des outputs de appel stewart 3232 3232 do il=1,ncum 3233 if (i.le.inb(il) .and. lwork(il)) THEN3233 IF (i.le.inb(il) .AND. lwork(il)) THEN 3234 3234 do ixt=1,ntraciso 3235 3235 CALL iso_verif_noNAN(xtp(ixt,il,i),'cv30_unsat 3382') … … 3237 3237 CALL iso_verif_noNAN(xtevap(ixt,il,i),'cv30_unsat 2661') 3238 3238 enddo 3239 if(iso_eau.gt.0) THEN3239 IF (iso_eau.gt.0) THEN 3240 3240 CALL iso_verif_egalite_choix(xtp(iso_eau,il,i), & 3241 3241 rpprec(il,i),'cv30_unsat 2736',errmax,errmaxrel) … … 3247 3247 evap(il,i),'cv30_unsat 2751',errmax,errmaxrel) 3248 3248 endif !if (iso_eau.gt.0) THEN 3249 if ((iso_HDO.gt.0).and. &3249 IF ((iso_HDO.gt.0).AND. & 3250 3250 (rp(il,i).gt.ridicule)) THEN 3251 3251 CALL iso_verif_aberrant(xtp(iso_HDO,il,i)/rpprec(il,i), & 3252 3252 'cv3unsat 2756') 3253 endif !if ((iso_HDO.gt.0). and.3253 endif !if ((iso_HDO.gt.0).AND. 3254 3254 #ifdef ISOTRAC 3255 ! if (il. eq.602) THEN3255 ! if (il.EQ.602) THEN 3256 3256 ! WRITE(*,*) 'cv30_routine tmp: il,i=',il,i 3257 3257 ! WRITE(*,*) 'xtp(iso_eau:ntraciso:3,il,i)=', … … 3272 3272 ! endif !if (option_tmin.ge.1) THEN 3273 3273 #endif 3274 endif !if (i.le.inb(il) . and. lwork(il)) THEN3274 endif !if (i.le.inb(il) .AND. lwork(il)) THEN 3275 3275 enddo !do il=1,ncum 3276 3276 #endif … … 3278 3278 ! equivalent isotopique de rp(il,i)=amin1(rp(il,i),rs(il,i)) 3279 3279 do il=1,ncum 3280 if (i.lt.inb(il) .and. lwork(il)) THEN3281 if(rpprec(il,i).gt.rs(il,i)) THEN3282 if(rs(il,i).le.0) THEN3280 IF (i.lt.inb(il) .AND. lwork(il)) THEN 3281 IF (rpprec(il,i).gt.rs(il,i)) THEN 3282 IF (rs(il,i).le.0) THEN 3283 3283 WRITE(*,*) 'cv3unsat 2640' 3284 3284 stop … … 3292 3292 CALL iso_verif_noNaN(xtp(ixt,il,i),'cv3unsat 2641') 3293 3293 enddo !do ixt=1,niso 3294 if(iso_eau.gt.0) THEN3294 IF (iso_eau.gt.0) THEN 3295 3295 ! WRITE(*,*) 'xtp(iso_eau,il,i)=',xtp(iso_eau,il,i) 3296 3296 CALL iso_verif_egalite_choix(xtp(iso_eau,il,i),rp(il,i), & … … 3299 3299 rs(il,i),'cv3unsat 2654',errmax,errmaxrel) 3300 3300 endif 3301 if ((iso_HDO.gt.0).and. &3301 IF ((iso_HDO.gt.0).AND. & 3302 3302 (rp(il,i).gt.ridicule)) THEN 3303 if(iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), &3304 'cv3unsat 2658'). eq.1) THEN3303 IF (iso_verif_aberrant_nostop(xtp(iso_HDO,il,i)/rp(il,i), & 3304 'cv3unsat 2658').EQ.1) THEN 3305 3305 WRITE(*,*) 'rpprec(il,i),rs(il,i),rp(il,i)=', & 3306 3306 rpprec(il,i),rs(il,i),rp(il,i) … … 3327 3327 do i=1,nl !nl 3328 3328 do il=1,ncum 3329 if(iso_eau.gt.0) THEN3329 IF (iso_eau.gt.0) THEN 3330 3330 ! WRITE(*,*) 'cv30_routines 2767:i,il,lwork(il),inb(il)=', 3331 3331 ! : i,il,lwork(il),inb(il) … … 3342 3342 ! if (iso_verif_traceur_choix_nostop(xtwater(1,il,i), 3343 3343 ! : 'cv30_routine 2982 unsat',errmax, 3344 ! : errmaxrel,ridicule_trac,deltalimtrac). eq.1) THEN3344 ! : errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN 3345 3345 ! WRITE(*,*) 'il,i,inb(il),lwork(il)=', 3346 3346 ! : il,i,inb(il),lwork(il) … … 3376 3376 ) 3377 3377 #ifdef ISO 3378 useinfotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso3379 useisotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O183380 #ifdef ISOVERIF 3381 useisotopes_verif_mod, ONLY: errmax,errmaxrel, &3378 USE infotrac_phy, ONLY: ntraciso=>ntiso, niso, nzone, itZonIso 3379 USE isotopes_mod, ONLY: essai_convergence,ridicule,iso_eau,iso_HDO,iso_O18 3380 #ifdef ISOVERIF 3381 USE isotopes_verif_mod, ONLY: errmax,errmaxrel, & 3382 3382 iso_verif_egalite_choix, iso_verif_noNaN,iso_verif_aberrant, & 3383 3383 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & … … 3388 3388 #endif 3389 3389 #ifdef ISOTRAC 3390 useisotrac_mod, ONLY: option_traceurs, &3390 USE isotrac_mod, ONLY: option_traceurs, & 3391 3391 izone_revap,izone_poubelle,izone_ddft 3392 3392 #ifdef ISOVERIF 3393 useisotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, &3393 USE isotopes_verif_mod, ONLY: iso_verif_traceur_choix_nostop,deltalimtrac, & 3394 3394 & iso_verif_tracpos_choix_nostop,iso_verif_traceur,iso_verif_traceur_justmass 3395 useisotrac_mod, ONLY: ridicule_trac3395 USE isotrac_mod, ONLY: ridicule_trac 3396 3396 #endif 3397 3397 #endif … … 3424 3424 REAL tv(nloc, nd), tvp(nloc, nd) 3425 3425 #ifdef ISO 3426 realxt(ntraciso,nloc,nd)3426 REAL xt(ntraciso,nloc,nd) 3427 3427 ! real xtep(ntraciso,nloc,na) ! le 7 mai: on supprime xtep 3428 realxtclw(ntraciso,nloc,na), xtp(ntraciso,nloc,na)3429 realxtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na)3430 realxtent(ntraciso,nloc,na,na), xtelij(ntraciso,nloc,na,na)3428 REAL xtclw(ntraciso,nloc,na), xtp(ntraciso,nloc,na) 3429 REAL xtwater(ntraciso,nloc,na), xtevap(ntraciso,nloc,na) 3430 REAL xtent(ntraciso,nloc,na,na), xtelij(ntraciso,nloc,na,na) 3431 3431 #ifdef ISOVERIF 3432 3432 CHARACTER (LEN=20) :: modname='cv30_compress' … … 3449 3449 REAL wd(nloc) ! gust 3450 3450 #ifdef ISO 3451 realxtprecip(ntraciso,nloc), fxt(ntraciso,nloc,nd)3452 realxtVprecip(ntraciso,nloc,nd+1)3451 REAL xtprecip(ntraciso,nloc), fxt(ntraciso,nloc,nd) 3452 REAL xtVprecip(ntraciso,nloc,nd+1) 3453 3453 #endif 3454 3454 … … 3466 3466 REAL siga(nloc, nd), sax(nloc, nd), mac(nloc, nd) ! cld 3467 3467 #ifdef ISO 3468 integerixt3469 realxtbx(ntraciso), xtawat(ntraciso)3468 INTEGER ixt 3469 REAL xtbx(ntraciso), xtawat(ntraciso) 3470 3470 ! cam debug 3471 3471 ! pour l'homogeneisation sous le nuage: 3472 realfrsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc)3472 REAL frsum(nloc), bxtsum(ntraciso,nloc), fxtsum(ntraciso,nloc) 3473 3473 ! correction dans calcul tendance liee a Am: 3474 realdq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp3475 logicalcorrection_excess_aberrant3474 REAL dq_tmp,k_tmp,dx_tmp,R_tmp,dqreste_tmp,dxreste_tmp,kad_tmp 3475 LOGICAL correction_excess_aberrant 3476 3476 parameter (correction_excess_aberrant=.FALSE.) 3477 3477 ! correction qui permettait d'eviter deltas et dexcess aberrants. Mais … … 3479 3479 #ifdef DIAGISO 3480 3480 ! diagnostiques juste: tendance des differents processus 3481 realfxt_detrainement(ntraciso,nloc,nd)3482 realfxt_fluxmasse(ntraciso,nloc,nd)3483 realfxt_evapprecip(ntraciso,nloc,nd)3484 realfxt_ddft(ntraciso,nloc,nd)3485 realfq_detrainement(nloc,nd)3486 realq_detrainement(nloc,nd)3487 realxt_detrainement(ntraciso,nloc,nd)3488 realf_detrainement(nloc,nd)3489 realfq_fluxmasse(nloc,nd)3490 realfq_evapprecip(nloc,nd)3491 realfq_ddft(nloc,nd)3481 REAL fxt_detrainement(ntraciso,nloc,nd) 3482 REAL fxt_fluxmasse(ntraciso,nloc,nd) 3483 REAL fxt_evapprecip(ntraciso,nloc,nd) 3484 REAL fxt_ddft(ntraciso,nloc,nd) 3485 REAL fq_detrainement(nloc,nd) 3486 REAL q_detrainement(nloc,nd) 3487 REAL xt_detrainement(ntraciso,nloc,nd) 3488 REAL f_detrainement(nloc,nd) 3489 REAL fq_fluxmasse(nloc,nd) 3490 REAL fq_evapprecip(nloc,nd) 3491 REAL fq_ddft(nloc,nd) 3492 3492 #endif 3493 3493 !#ifdef ISOVERIF … … 3498 3498 ! integer iso_verif_traceur_choix_nostop 3499 3499 ! integer iso_verif_tracpos_choix_nostop 3500 realxtnew(ntraciso)3500 REAL xtnew(ntraciso) 3501 3501 ! real conversion(niso) 3502 realfxtYe(niso)3503 realfxtqe(niso)3504 realfxtXe(niso)3505 realfxt_revap(niso)3506 realXe(niso)3507 integerixt_revap,izone3508 integer ixt_poubelle, ixt_ddft,iiso3502 REAL fxtYe(niso) 3503 REAL fxtqe(niso) 3504 REAL fxtXe(niso) 3505 REAL fxt_revap(niso) 3506 REAL Xe(niso) 3507 INTEGER ixt_revap,izone 3508 INTEGER ixt_poubelle, ixt_ddft,iiso 3509 3509 #endif 3510 3510 #endif … … 3596 3596 ! cam verif 3597 3597 #ifdef ISOVERIF 3598 if(iso_eau.gt.0) THEN3598 IF (iso_eau.gt.0) THEN 3599 3599 ! WRITE(*,*) 'cv30_yield 2952: '// 3600 3600 ! : 'il,water(il,1),xtwater(iso_eau,il,1)=' … … 3612 3612 CALL iso_verif_traceur(xtwater(1,il,1), & 3613 3613 'cv30_routine 3146') 3614 if(iso_verif_traceur_choix_nostop(xtprecip(1,il), &3614 IF (iso_verif_traceur_choix_nostop(xtprecip(1,il), & 3615 3615 'cv30_routine 3147',errmax*1e2, & 3616 errmaxrel,ridicule_trac,deltalimtrac). eq.1) THEN3616 errmaxrel,ridicule_trac,deltalimtrac).EQ.1) THEN 3617 3617 WRITE(*,*) 'il,inb(il)=',il,inb(il) 3618 3618 WRITE(*,*) 'xtwater(:,il,1)=',xtwater(:,il,1) … … 3633 3633 ! cam verif 3634 3634 #ifdef ISOVERIF 3635 if(iso_eau.gt.0) THEN3635 IF (iso_eau.gt.0) THEN 3636 3636 CALL iso_verif_egalite_choix(xtprecip(iso_eau,il), & 3637 3637 precip(il),'cv30_routines 3139', & … … 3795 3795 ! calcule R_tmp. 3796 3796 dq_tmp=0.01*grav*am(il)*(rr(il,2)-rr(il,1))*work(il)*delt ! utile ci-dessous 3797 if ((dq_tmp/rr(il,1).lt.-0.9).and.correction_excess_aberrant) THEN3797 IF ((dq_tmp/rr(il,1).lt.-0.9).AND.correction_excess_aberrant) THEN 3798 3798 ! nouvelle formulation ou on fait d'abord entrer k*q2 et ensuite 3799 3799 ! seulement on fait sortir k*q1 sans changement de composition … … 3810 3810 + dx_tmp/delt 3811 3811 #ifdef ISOVERIF 3812 if (ixt.eq.iso_HDO) THEN3812 IF (ixt.EQ.iso_HDO) THEN 3813 3813 WRITE(*,*) 'cv30_routines 3888: il=',il 3814 3814 WRITE(*,*) 'dq_tmp,rr(il,1)=',dq_tmp,rr(il,1) … … 3824 3824 WRITE(*,*) 'formule classique: fxt_Am=',0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) 3825 3825 WRITE(*,*) 'donnerait dxt=',0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il)*delt 3826 endif !if (ixt. eq.iso_HDO) THEN3826 endif !if (ixt.EQ.iso_HDO) THEN 3827 3827 #endif 3828 3828 #ifdef DIAGISO 3829 if(ixt.le.niso) THEN3829 IF (ixt.le.niso) THEN 3830 3830 fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) & 3831 3831 + dx_tmp/delt … … 3840 3840 +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) 3841 3841 #ifdef DIAGISO 3842 if(ixt.le.niso) THEN3842 IF (ixt.le.niso) THEN 3843 3843 fxt_fluxmasse(ixt,il,1)=fxt_fluxmasse(ixt,il,1) & 3844 3844 +0.01*grav*am(il)*(xt(ixt,il,2)-xt(ixt,il,1))*work(il) … … 3849 3849 ! cam verif 3850 3850 #ifdef ISOVERIF 3851 if(iso_eau.gt.0) THEN3851 IF (iso_eau.gt.0) THEN 3852 3852 CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), & 3853 3853 fr(il,1),'cv30_routines 3251', & … … 3855 3855 endif !if (iso_eau.gt.0) THEN 3856 3856 !WRITE(*,*) 'il,am(il)=',il,am(il) 3857 if ((iso_HDO.gt.0).and. &3857 IF ((iso_HDO.gt.0).AND. & 3858 3858 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN 3859 if(iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,1) &3859 IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,1) & 3860 3860 +delt*fxt(iso_HDO,il,1))/(rr(il,1)+delt*fr(il,1)), & 3861 'cv30_yield 3125, ddft en 1'). eq.1) THEN3861 'cv30_yield 3125, ddft en 1').EQ.1) THEN 3862 3862 WRITE(*,*) 'il,rr(il,1),delt=',il,rr(il,1),delt 3863 3863 WRITE(*,*) 'deltaDxt=',deltaD(xt(iso_HDO,il,1)/rr(il,1)) … … 3881 3881 xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1) 3882 3882 enddo 3883 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3395',1e-5) &3884 . eq.1) THEN3883 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3395',1e-5) & 3884 .EQ.1) THEN 3885 3885 WRITE(*,*) 'il=',il 3886 3886 WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1) … … 3943 3943 ! cam verif 3944 3944 #ifdef ISOVERIF 3945 if(iso_eau.gt.0) THEN3945 IF (iso_eau.gt.0) THEN 3946 3946 CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), & 3947 3947 fr(il,1),'cv30_routines 3023', & 3948 3948 errmax,errmaxrel) 3949 3949 endif !if (iso_eau.gt.0) THEN 3950 if ((iso_HDO.gt.0).and. &3950 IF ((iso_HDO.gt.0).AND. & 3951 3951 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN 3952 3952 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) & … … 3961 3961 xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1) 3962 3962 enddo 3963 if(iso_verif_tracpos_choix_nostop(xtnew, &3963 IF (iso_verif_tracpos_choix_nostop(xtnew, & 3964 3964 'cv30_yield 3449',1e-5) & 3965 . eq.1) THEN3965 .EQ.1) THEN 3966 3966 WRITE(*,*) 'il=',il 3967 3967 WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1) … … 3991 3991 ! : *(mp(il,2)*(trap(il,2,j)-tra(il,1,j)) 3992 3992 ! : +am(il)*(tra(il,2,j)-tra(il,1,j))) 3993 ! endif3993 ! END IF 3994 3994 ! enddo 3995 3995 ! enddo … … 4029 4029 ! cam verif 4030 4030 #ifdef ISOVERIF 4031 if(iso_eau.gt.0) THEN4031 IF (iso_eau.gt.0) THEN 4032 4032 CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), & 4033 4033 fr(il,1),'cv30_routines 3251',errmax,errmaxrel) 4034 4034 endif !if (iso_eau.gt.0) THEN 4035 if ((iso_HDO.gt.0).and. &4035 IF ((iso_HDO.gt.0).AND. & 4036 4036 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN 4037 4037 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) & … … 4044 4044 xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1) 4045 4045 enddo 4046 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3525',1e-5) &4047 . eq.1) THEN4046 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3525',1e-5) & 4047 .EQ.1) THEN 4048 4048 WRITE(*,*) 'il=',il 4049 4049 WRITE(*,*) 'delt,fxt(:,il,1)=',delt,fxt(:,il,1) … … 4089 4089 ! cam verif 4090 4090 #ifdef ISOVERIF 4091 if(iso_eau.gt.0) THEN4091 IF (iso_eau.gt.0) THEN 4092 4092 CALL iso_verif_egalite_choix(fxt(iso_eau,il,1), & 4093 4093 fr(il,1),'cv30_routines 3092',errmax,errmaxrel) 4094 4094 endif !if (iso_eau.gt.0) THEN 4095 if ((iso_HDO.gt.0).and. &4095 IF ((iso_HDO.gt.0).AND. & 4096 4096 (rr(il,1)+delt*fr(il,1).gt.ridicule)) THEN 4097 4097 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,1) & … … 4104 4104 xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1) 4105 4105 enddo 4106 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) &4107 . eq.1) THEN4106 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3753',1e-5) & 4107 .EQ.1) THEN 4108 4108 WRITE(*,*) 'il=',il 4109 4109 endif … … 4128 4128 ! ftra(il,1,k)=ftra(il,1,k)+0.1*work(il)*ment(il,j,1) 4129 4129 ! : *(traent(il,j,1,k)-tra(il,1,k)) 4130 ! endif4131 4132 ! endif4130 ! END IF 4131 4132 ! END IF 4133 4133 ! enddo 4134 4134 ! enddo … … 4245 4245 -ad(il)*(rr(il,i)-rr(il,i-1)))*delt 4246 4246 ! c'est equivalent a dqi= kamp1*qip1+kad*qim1-(kamp1+kad)*qi 4247 if ((dq_tmp/rr(il,i).lt.-0.9).and.correction_excess_aberrant) THEN4247 IF ((dq_tmp/rr(il,i).lt.-0.9).AND.correction_excess_aberrant) THEN 4248 4248 ! nouvelle formulation 4249 4249 k_tmp=0.01*grav*dpinv*amp1(il)*delt … … 4255 4255 fxt(ixt,il,i)= dx_tmp/delt 4256 4256 #ifdef ISOVERIF 4257 if ((ixt.eq.iso_HDO).or.(ixt.eq.iso_eau)) THEN4257 IF ((ixt.EQ.iso_HDO).OR.(ixt.EQ.iso_eau)) THEN 4258 4258 WRITE(*,*) 'cv30_routines 4367: il,i,ixt=',il,i,ixt 4259 4259 WRITE(*,*) 'dq_tmp,rr(il,i)=',dq_tmp,rr(il,i) … … 4268 4268 xt(ixt,il,i)+fxt(ixt,il,i)*delt 4269 4269 WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i) 4270 endif !if (ixt. eq.iso_HDO) THEN4270 endif !if (ixt.EQ.iso_HDO) THEN 4271 4271 #endif 4272 4272 enddo ! do ixt = 1, ntraciso … … 4293 4293 ! cam verif 4294 4294 #ifdef ISOVERIF 4295 if(iso_eau.gt.0) THEN4295 IF (iso_eau.gt.0) THEN 4296 4296 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4297 4297 fr(il,i),'cv30_routines 3226',errmax,errmaxrel) … … 4300 4300 CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3229') 4301 4301 enddo 4302 if ((iso_HDO.gt.0).and. &4302 IF ((iso_HDO.gt.0).AND. & 4303 4303 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4304 4304 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & … … 4307 4307 'cv30_yield 3384, flux masse') 4308 4308 endif !if (iso_HDO.gt.0) THEN 4309 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &4309 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 4310 4310 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4311 4311 CALL iso_verif_O18_aberrant( & … … 4319 4319 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4320 4320 enddo 4321 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3727',1e-5) &4322 . eq.1) THEN4321 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3727',1e-5) & 4322 .EQ.1) THEN 4323 4323 WRITE(*,*) 'il,i=',il,i 4324 4324 WRITE(*,*) 'fxt(:,il,i)=',fxt(:,il,i) … … 4362 4362 ! cam verif 4363 4363 #ifdef ISOVERIF 4364 if(iso_eau.gt.0) THEN4364 IF (iso_eau.gt.0) THEN 4365 4365 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4366 4366 fr(il,i),'cv30_routines 3252',errmax,errmaxrel) … … 4370 4370 enddo 4371 4371 ! correction 21 oct 2008 4372 if ((iso_HDO.gt.0).and. &4372 IF ((iso_HDO.gt.0).AND. & 4373 4373 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4374 4374 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & 4375 4375 +delt*fxt(iso_HDO,il,i))/(rr(il,i)+delt*fr(il,i)), & 4376 4376 'cv30_yield 3384b flux masse') 4377 if(iso_O18.gt.0) THEN4377 IF (iso_O18.gt.0) THEN 4378 4378 CALL iso_verif_O18_aberrant( & 4379 4379 (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) & … … 4389 4389 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4390 4390 enddo 4391 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) &4392 . eq.1) THEN4391 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3775',1e-5) & 4392 .EQ.1) THEN 4393 4393 WRITE(*,*) 'il,i=',il,i 4394 4394 endif … … 4415 4415 ! : *(amp1(il)*(tra(il,i+1,k)-tra(il,i,k)) 4416 4416 ! : -ad(il)*(tra(il,i,k)-tra(il,i-1,k))) 4417 ! endif4418 ! endif4417 ! END IF 4418 ! END IF 4419 4419 ! enddo 4420 4420 ! enddo … … 4439 4439 ! ce surplus a la meme compo que le elij, sans fractionnement. 4440 4440 ! d'ou le nouveau traitement ci-dessous. 4441 if(elij(il,k,i).gt.0.0) THEN4441 IF (elij(il,k,i).gt.0.0) THEN 4442 4442 do ixt = 1, ntraciso 4443 4443 xtawat(ixt)=awat*(xtelij(ixt,il,k,i)/elij(il,k,i)) … … 4457 4457 ! cam verif 4458 4458 #ifdef ISOVERIF 4459 if(iso_eau.gt.0) THEN4459 IF (iso_eau.gt.0) THEN 4460 4460 CALL iso_verif_egalite_choix(xtawat(iso_eau), & 4461 4461 awat,'cv30_routines 3301',errmax,errmaxrel) … … 4501 4501 ! cam verif 4502 4502 #ifdef ISOVERIF 4503 if(iso_eau.gt.0) THEN4503 IF (iso_eau.gt.0) THEN 4504 4504 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4505 4505 fr(il,i),'cv30_routines 3325',errmax,errmaxrel) … … 4508 4508 CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3328') 4509 4509 enddo 4510 if ((iso_HDO.gt.0).and. &4510 IF ((iso_HDO.gt.0).AND. & 4511 4511 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4512 if(iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &4512 IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) & 4513 4513 +delt*fxt(iso_HDO,il,i)) & 4514 4514 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396a, dtr mels') & 4515 . eq.1) THEN4515 .EQ.1) THEN 4516 4516 WRITE(*,*) 'il,k,i=',il,k,i 4517 4517 WRITE(*,*) 'rr,delt,fr=',rr(il,i),delt,fr(il,i) … … 4536 4536 ! stop 4537 4537 endif 4538 if(iso_O18.gt.0) THEN4538 IF (iso_O18.gt.0) THEN 4539 4539 CALL iso_verif_O18_aberrant( & 4540 4540 (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) & … … 4550 4550 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4551 4551 enddo 4552 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) &4553 . eq.1) THEN4552 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3905',1e-5) & 4553 .EQ.1) THEN 4554 4554 WRITE(*,*) 'il,i=',il,i 4555 4555 endif … … 4591 4591 ! cam verif 4592 4592 #ifdef ISOVERIF 4593 if(iso_eau.gt.0) THEN4593 IF (iso_eau.gt.0) THEN 4594 4594 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4595 4595 fr(il,i),'cv30_routines 3350',errmax,errmaxrel) … … 4598 4598 CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3353') 4599 4599 enddo 4600 if ((iso_HDO.gt.0).and. &4600 IF ((iso_HDO.gt.0).AND. & 4601 4601 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4602 4602 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & … … 4604 4604 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3396b, dtr mels') 4605 4605 endif !if (iso_HDO.gt.0) THEN 4606 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &4606 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 4607 4607 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4608 4608 CALL iso_verif_O18_aberrant( & … … 4616 4616 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4617 4617 enddo 4618 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) &4619 . eq.1) THEN4618 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 3949',1e-5) & 4619 .EQ.1) THEN 4620 4620 WRITE(*,*) 'il,i=',il,i 4621 4621 endif … … 4647 4647 ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i) 4648 4648 ! : *(traent(il,k,i,j)-tra(il,i,j)) 4649 ! endif4650 ! endif4649 ! END IF 4650 ! END IF 4651 4651 ! enddo 4652 4652 ! enddo … … 4689 4689 ! cam verif 4690 4690 #ifdef ISOVERIF 4691 if ((il.eq.1636).and.(i.eq.9)) THEN4691 IF ((il.EQ.1636).AND.(i.EQ.9)) THEN 4692 4692 WRITE(*,*) 'cv30 4785: on ajoute le dtr ici:' 4693 4693 WRITE(*,*) 'M=',0.01*grav*dpinv*ment(il, k, i) … … 4703 4703 #endif 4704 4704 #ifdef ISOVERIF 4705 if(iso_eau.gt.0) THEN4705 IF (iso_eau.gt.0) THEN 4706 4706 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4707 4707 fr(il,i),'cv30_routines 3408',errmax,errmaxrel) … … 4710 4710 CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3411') 4711 4711 enddo 4712 if (1.eq.0) THEN4713 if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN4714 if(iso_verif_aberrant_enc_nostop( &4712 IF (1.EQ.0) THEN 4713 IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN 4714 IF (iso_verif_aberrant_enc_nostop( & 4715 4715 fxt(iso_HDO,il,i)/fr(il,i), & 4716 'cv30_yield 3572, dtr mels'). eq.1) THEN4716 'cv30_yield 3572, dtr mels').EQ.1) THEN 4717 4717 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il) 4718 4718 WRITE(*,*) 'fr(il,i)=',fr(il,i) … … 4722 4722 endif 4723 4723 endif !if (iso_HDO.gt.0) THEN 4724 endif !if (1. eq.0) THEN4725 if ((iso_HDO.gt.0).and. &4724 endif !if (1.EQ.0) THEN 4725 IF ((iso_HDO.gt.0).AND. & 4726 4726 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4727 4727 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & 4728 4728 +delt*fxt(iso_HDO,il,i)) & 4729 4729 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3605, dtr mels') 4730 if(iso_O18.gt.0) THEN4730 IF (iso_O18.gt.0) THEN 4731 4731 CALL iso_verif_O18_aberrant( & 4732 4732 (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) & … … 4735 4735 /(rr(il,i)+delt*fr(il,i)), & 4736 4736 'cv30_yield 3605O18, dtr mels') 4737 if ((il.eq.1636).and.(i.eq.9)) THEN4737 IF ((il.EQ.1636).AND.(i.EQ.9)) THEN 4738 4738 CALL iso_verif_O18_aberrant( & 4739 4739 (xt(iso_HDO,il,i)+delt*(fxt(iso_HDO,il,i)-xtbx(iso_HDO))) & … … 4742 4742 /(rr(il,i)+delt*(fr(il,i)-bx)), & 4743 4743 'cv30_yield 3605O18_nobx, dtr mels') 4744 endif !if ((il. eq.1636).and.(i.eq.9)) THEN4744 endif !if ((il.EQ.1636).AND.(i.EQ.9)) THEN 4745 4745 endif !if (iso_O18.gt.0) THEN 4746 4746 endif !if (iso_HDO.gt.0) THEN … … 4750 4750 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4751 4751 enddo 4752 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) &4753 . eq.1) THEN4752 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4036',1e-5) & 4753 .EQ.1) THEN 4754 4754 WRITE(*,*) 'il,i=',il,i 4755 4755 endif … … 4790 4790 ! cam verif 4791 4791 #ifdef ISOVERIF 4792 if ((il.eq.1636).and.(i.eq.9)) THEN4792 IF ((il.EQ.1636).AND.(i.EQ.9)) THEN 4793 4793 WRITE(*,*) 'cv30 4785b: on ajoute le dtr ici:' 4794 4794 WRITE(*,*) 'M=',0.1*dpinv*ment(il, k, i) 4795 4795 WRITE(*,*) 'q,qe=',rr(il,i),qent(il,k,i) 4796 4796 endif 4797 if(iso_eau.gt.0) THEN4797 IF (iso_eau.gt.0) THEN 4798 4798 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 4799 4799 fr(il,i),'cv30_routines 3433',errmax,errmaxrel) … … 4802 4802 CALL iso_verif_noNAN(fxt(ixt,il,i),'cv30_routines 3436') 4803 4803 enddo 4804 if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN4805 if(iso_verif_aberrant_enc_nostop( &4804 IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN 4805 IF (iso_verif_aberrant_enc_nostop( & 4806 4806 fxt(iso_HDO,il,i)/fr(il,i), & 4807 'cv30_yield 3597'). eq.1) THEN4807 'cv30_yield 3597').EQ.1) THEN 4808 4808 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il) 4809 4809 stop 4810 4810 endif 4811 4811 endif !if (iso_HDO.gt.0) THEN 4812 if ((iso_HDO.gt.0).and. &4812 IF ((iso_HDO.gt.0).AND. & 4813 4813 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4814 4814 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & … … 4821 4821 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 4822 4822 enddo 4823 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) &4824 . eq.1) THEN4823 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4091',1e-5) & 4824 .EQ.1) THEN 4825 4825 WRITE(*,*) 'il,i=',il,i 4826 4826 endif … … 4838 4838 ! do k=i,nl+1 4839 4839 ! do il=1,ncum 4840 ! if (i.le.inb(il) . and. k.le.inb(il)) THEN4840 ! if (i.le.inb(il) .AND. k.le.inb(il)) THEN 4841 4841 ! dpinv=1.0/(ph(il,i)-ph(il,i+1)) 4842 4842 ! cpinv=1.0/cpn(il,i) … … 4847 4847 ! ftra(il,i,j)=ftra(il,i,j)+0.1*dpinv*ment(il,k,i) 4848 4848 ! : *(traent(il,k,i,j)-tra(il,i,j)) 4849 ! endif4850 ! endif! i and k4849 ! END IF 4850 ! END IF ! i and k 4851 4851 ! enddo 4852 4852 ! enddo … … 4898 4898 CALL iso_verif_noNaN(fxt(ixt,il,i),'cv30_yield 4515') 4899 4899 enddo 4900 if ((iso_HDO.gt.0).and. &4900 IF ((iso_HDO.gt.0).AND. & 4901 4901 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4902 if(iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &4902 IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) & 4903 4903 +delt*fxt(iso_HDO,il,i)) & 4904 4904 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 4175') & 4905 . eq.1) THEN4905 .EQ.1) THEN 4906 4906 WRITE(*,*) 'il,i=',il,i 4907 if (rr(il,i).ne.0.0) THEN4907 IF (rr(il,i).NE.0.0) THEN 4908 4908 WRITE(*,*) 'il,i,rr,deltaD=',il,i,rr(il,i),deltaD & 4909 4909 (xt(iso_HDO,il,i)/rr(il,i)) 4910 4910 endif 4911 if (fr(il,i).ne.0.0) THEN4911 IF (fr(il,i).NE.0.0) THEN 4912 4912 WRITE(*,*) 'fr,fxt,deltaD=',fr(il,i),fxt(iso_HDO,il,i), & 4913 4913 deltaD(fxt(iso_HDO,il,i)/fr(il,i)) 4914 4914 endif 4915 4915 #ifdef DIAGISO 4916 if (fq_ddft(il,i).ne.0.0) THEN4916 IF (fq_ddft(il,i).NE.0.0) THEN 4917 4917 WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( & 4918 4918 fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i)) 4919 4919 endif 4920 if (fq_evapprecip(il,i).ne.0.0) THEN4920 IF (fq_evapprecip(il,i).NE.0.0) THEN 4921 4921 WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i),deltaD( & 4922 4922 fxt_evapprecip(iso_HDO,il,i)/fq_evapprecip(il,i)) … … 4937 4937 endif 4938 4938 endif !if (iso_HDO.gt.0) THEN 4939 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &4939 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 4940 4940 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 4941 4941 CALL iso_verif_O18_aberrant( & … … 4943 4943 (xt(iso_O18,il,i)+delt*fxt(iso_O18,il,i))/(rr(il,i)+delt*fr(il,i)), & 4944 4944 'cv30_yield 5029,O18, evap') 4945 if ((il.eq.1636).and.(i.eq.9)) THEN4945 IF ((il.EQ.1636).AND.(i.EQ.9)) THEN 4946 4946 WRITE(*,*) 'cv30_yield 5057: ici, on verifie deltaD_nobx' 4947 4947 WRITE(*,*) 'il,i=',il,i … … 4958 4958 /(rr(il,i)+delt*(fr(il,i)-bx)), & 4959 4959 'cv30_yield 5029_nobx,O18, evap, no bx') 4960 endif !if ((il. eq.1636).and.(i.eq.9)) THEN4960 endif !if ((il.EQ.1636).AND.(i.EQ.9)) THEN 4961 4961 endif !if (iso_HDO.gt.0) THEN 4962 4962 #endif 4963 4963 4964 4964 #ifdef ISOTRAC 4965 if ((option_traceurs.ne.6).and.(option_traceurs.ne.19)) THEN4965 IF ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN 4966 4966 ! facile: on fait comme l'eau 4967 4967 do ixt = 1+niso,ntraciso … … 5001 5001 ! WRITE(*,*) 'tmp cv3_yield 4165: i,il=',i,il 5002 5002 5003 if (option_traceurs.eq.6) THEN5003 IF (option_traceurs.EQ.6) THEN 5004 5004 do iiso = 1, niso 5005 5005 5006 5006 ixt_ddft=itZonIso(izone_ddft,iiso) 5007 if(mp(il,i).gt.mp(il,i+1)) THEN5007 IF (mp(il,i).gt.mp(il,i+1)) THEN 5008 5008 fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) & 5009 5009 *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i)) … … 5023 5023 enddo !do iiso = 1, niso 5024 5024 5025 else !if (option_traceurs. eq.6) THEN5026 if(mp(il,i).gt.mp(il,i+1)) THEN5025 else !if (option_traceurs.EQ.6) THEN 5026 IF (mp(il,i).gt.mp(il,i+1)) THEN 5027 5027 ! cas entrainant: faire attention 5028 5028 … … 5047 5047 Xe(iiso)=xt(iiso,il,i) & 5048 5048 -xt(ixt_ddft,il,i)-xt(ixt_revap,il,i) 5049 if(Xe(iiso).gt.ridicule) THEN5049 IF (Xe(iiso).gt.ridicule) THEN 5050 5050 do izone=1,nzone 5051 if ((izone.ne.izone_revap).and. &5052 (izone. ne.izone_ddft)) THEN5051 IF ((izone.NE.izone_revap).AND. & 5052 (izone.NE.izone_ddft)) THEN 5053 5053 ixt=itZonIso(izone,iiso) 5054 5054 fxt(ixt,il,i)=fxt(ixt,il,i) & 5055 5055 +xt(ixt,il,i)/Xe(iiso)*fxtXe(iiso) 5056 endif !if ((izone. ne.izone_revap).and.5056 endif !if ((izone.NE.izone_revap).AND. 5057 5057 enddo !do izone=1,nzone 5058 5058 #ifdef ISOVERIF … … 5071 5071 5072 5072 #ifdef ISOVERIF 5073 if(delt*fxtXe(iiso).gt.ridicule) THEN5073 IF (delt*fxtXe(iiso).gt.ridicule) THEN 5074 5074 WRITE(*,*) 'cv30_routines 6563: delt*fxtXe(iiso)=', & 5075 5075 delt*fxtXe(iiso) … … 5078 5078 #endif 5079 5079 do izone=1,nzone 5080 if ((izone.ne.izone_revap).and. &5081 (izone. ne.izone_ddft)) THEN5080 IF ((izone.NE.izone_revap).AND. & 5081 (izone.NE.izone_ddft)) THEN 5082 5082 ixt=itZonIso(izone,iiso) 5083 if (izone.eq.izone_poubelle) THEN5083 IF (izone.EQ.izone_poubelle) THEN 5084 5084 fxt(ixt,il,i)=fxt(ixt,il,i)+fxtXe(iiso) 5085 else !if (izone. eq.izone_poubelle) THEN5085 else !if (izone.EQ.izone_poubelle) THEN 5086 5086 ! pas de tendance pour ce tag la 5087 endif !if (izone. eq.izone_poubelle) THEN5088 endif !if ((izone. ne.izone_revap).and.5087 endif !if (izone.EQ.izone_poubelle) THEN 5088 endif !if ((izone.NE.izone_revap).AND. 5089 5089 enddo !do izone=1,nzone 5090 5090 #ifdef ISOVERIF … … 5108 5108 #endif 5109 5109 endif !if (mp(il,i).gt.mp(il,i+1)) THEN 5110 endif !if (option_traceurs. eq.6) THEN5110 endif !if (option_traceurs.EQ.6) THEN 5111 5111 ! WRITE(*,*) 'delt*conversion=',delt*conversion(iso_eau) 5112 5112 ! WRITE(*,*) 'delt*fxtYe=',delt*fxtYe(iso_eau) 5113 5113 ! WRITE(*,*) 'delt*fxtqe=',delt*fxtqe(iso_eau) 5114 5114 5115 endif ! if ((option_traceurs. ne.6).and.(option_traceurs.ne.19)) THEN5115 endif ! if ((option_traceurs.NE.6).AND.(option_traceurs.NE.19)) THEN 5116 5116 #endif 5117 5117 … … 5123 5123 #endif 5124 5124 #ifdef ISOVERIF 5125 if(iso_eau.gt.0) THEN5125 IF (iso_eau.gt.0) THEN 5126 5126 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 5127 5127 fr(il,i),'cv30_routines 3493',errmax,errmaxrel) 5128 5128 endif !if (iso_eau.gt.0) THEN 5129 if (1.eq.0) THEN5130 if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN5131 if(iso_verif_aberrant_enc_nostop( &5129 IF (1.EQ.0) THEN 5130 IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN 5131 IF (iso_verif_aberrant_enc_nostop( & 5132 5132 fxt(iso_HDO,il,i)/fr(il,i), & 5133 'cv30_yield 3662'). eq.1) THEN5133 'cv30_yield 3662').EQ.1) THEN 5134 5134 WRITE(*,*) 'il,i,icb(il),inb(il)=',il,i,icb(il),inb(il) 5135 5135 WRITE(*,*) 'fr(il,i),delt=',fr(il,i),delt 5136 5136 #ifdef DIAGISO 5137 if (fq_ddft(il,i).ne.0.0) THEN5137 IF (fq_ddft(il,i).NE.0.0) THEN 5138 5138 WRITE(*,*) 'fq_ddft,deltaD=',fq_ddft(il,i),deltaD( & 5139 5139 fxt_ddft(iso_HDO,il,i)/fq_ddft(il,i)) 5140 endif !if (fq_ddft(il,i). ne.0.0) THEN5141 if (fq_evapprecip(il,i).ne.0.0) THEN5140 endif !if (fq_ddft(il,i).NE.0.0) THEN 5141 IF (fq_evapprecip(il,i).NE.0.0) THEN 5142 5142 WRITE(*,*) 'fq_evapprecip,deltaD=',fq_evapprecip(il,i), & 5143 5143 deltaD(fxt_evapprecip(iso_HDO,il,i) & 5144 5144 /fq_evapprecip(il,i)) 5145 endif !if (fq_evapprecip(il,i). ne.0.0) THEN5145 endif !if (fq_evapprecip(il,i).NE.0.0) THEN 5146 5146 #endif 5147 5147 endif !if (iso_verif_aberrant_enc_nostop( 5148 5148 endif !if (iso_HDO.gt.0) THEN 5149 endif !if (1. eq.0) THEN5150 if ((iso_HDO.gt.0).and. &5149 endif !if (1.EQ.0) THEN 5150 IF ((iso_HDO.gt.0).AND. & 5151 5151 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5152 if(iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) &5152 IF (iso_verif_aberrant_enc_nostop((xt(iso_HDO,il,i) & 5153 5153 +delt*fxt(iso_HDO,il,i)) & 5154 5154 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757, ddfts') & 5155 . eq.1) THEN5155 .EQ.1) THEN 5156 5156 WRITE(*,*) 'i,il,q,deltaD=',i,il,rr(il,i),deltaD( & 5157 5157 xt(iso_HDO,il,i)/rr(il,i)) … … 5161 5161 endif ! if (iso_verif_aberrant_enc_nostop 5162 5162 endif !if (iso_HDO.gt.0) THEN 5163 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &5163 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 5164 5164 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5165 5165 CALL iso_verif_O18_aberrant( & … … 5174 5174 xtnew(ixt)=xt(ixt,il,i)+delt*fxt(ixt,il,i) 5175 5175 enddo 5176 if(iso_verif_tracpos_choix_nostop(xtnew, &5177 'cv30_yield 4221',1e-5). eq.1) THEN5176 IF (iso_verif_tracpos_choix_nostop(xtnew, & 5177 'cv30_yield 4221',1e-5).EQ.1) THEN 5178 5178 WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(1:ntraciso:2,il,i) 5179 5179 WRITE(*,*) 'delt*fxt(,il,i)=',delt*fxt(:,il,i) … … 5213 5213 5214 5214 #ifdef ISOTRAC 5215 if (option_traceurs.ne.6) THEN5215 IF (option_traceurs.NE.6) THEN 5216 5216 ! facile: on fait comme l'eau 5217 5217 do ixt = 1+niso,ntraciso … … 5222 5222 enddo !do ixt = 1+niso,ntraciso 5223 5223 5224 else !if (option_traceurs. ne.6) THEN5224 else !if (option_traceurs.NE.6) THEN 5225 5225 ! taggage des ddfts: voir blabla + haut 5226 5226 do ixt = 1+niso,ntraciso … … 5238 5238 ixt_poubelle=itZonIso(izone_poubelle,iiso) 5239 5239 ixt_ddft=itZonIso(izone_ddft,iiso) 5240 if(mp(il,i).gt.mp(il,i+1)) THEN5240 IF (mp(il,i).gt.mp(il,i+1)) THEN 5241 5241 fxtYe(iiso)=0.01*grav*dpinv*mp(il,i) & 5242 5242 *(xt(ixt_ddft,il,i-1)-xt(ixt_ddft,il,i)) … … 5256 5256 ! WRITE(*,*) 'delt*fxtYe=',delt*fxtYe(iso_eau) 5257 5257 ! WRITE(*,*) 'delt*fxtqe=',delt*fxtqe(iso_eau) 5258 endif !if (option_traceurs. eq.6) THEN5258 endif !if (option_traceurs.EQ.6) THEN 5259 5259 #endif 5260 5260 … … 5282 5282 #endif 5283 5283 #ifdef ISOVERIF 5284 if(iso_eau.gt.0) THEN5284 IF (iso_eau.gt.0) THEN 5285 5285 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 5286 5286 fr(il,i),'cv30_routines 3522',errmax,errmaxrel) 5287 5287 endif !if (iso_eau.gt.0) THEN 5288 if ((iso_HDO.gt.0).and.(delt*fr(il,i).gt.ridicule)) THEN5289 if(iso_verif_aberrant_enc_nostop( &5288 IF ((iso_HDO.gt.0).AND.(delt*fr(il,i).gt.ridicule)) THEN 5289 IF (iso_verif_aberrant_enc_nostop( & 5290 5290 fxt(iso_HDO,il,i)/fr(il,i), & 5291 'cv30_yield 3690'). eq.1) THEN5291 'cv30_yield 3690').EQ.1) THEN 5292 5292 WRITE(*,*) 'i,icb(il),inb(il)=',i,icb(il),inb(il) 5293 5293 stop 5294 5294 endif 5295 5295 endif !if (iso_HDO.gt.0) THEN 5296 if ((iso_HDO.gt.0).and. &5296 IF ((iso_HDO.gt.0).AND. & 5297 5297 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5298 5298 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & … … 5300 5300 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3757b, ddfts') 5301 5301 endif !if (iso_HDO.gt.0) THEN 5302 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &5302 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 5303 5303 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5304 5304 CALL iso_verif_O18_aberrant( & … … 5312 5312 xtnew(ixt)=xt(ixt,il,1)+delt*fxt(ixt,il,1) 5313 5313 enddo 5314 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) &5315 . eq.1) THEN5314 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4295',1e-5) & 5315 .EQ.1) THEN 5316 5316 WRITE(*,*) 'il,i=',il,i 5317 5317 endif … … 5367 5367 ! : *(mp(il,i+1)*(trap(il,i+1,j)-tra(il,i,j)) 5368 5368 ! : -mp(il,i)*(trap(il,i,j)-tra(il,i-1,j))) 5369 ! endif5370 ! endif! i5369 ! END IF 5370 ! END IF ! i 5371 5371 ! enddo 5372 5372 ! enddo … … 5486 5486 CALL iso_verif_noNaN(fxt(ixt,il,inb(il)),'cv30_yield 5083') 5487 5487 enddo 5488 if(iso_eau.gt.0) THEN5488 IF (iso_eau.gt.0) THEN 5489 5489 CALL iso_verif_egalite_choix(fxt(iso_eau,il,inb(il)), & 5490 5490 fr(il,inb(il)),'cv30_routines 3638',errmax,errmaxrel) … … 5492 5492 fr(il,inb(il)-1),'cv30_routines 3640',errmax,errmaxrel) 5493 5493 endif !if (iso_eau.gt.0) THEN 5494 if ((iso_HDO.gt.0).and. &5494 IF ((iso_HDO.gt.0).AND. & 5495 5495 (rr(il,inb(il))+delt*fr(il,inb(il)).gt.ridicule)) THEN 5496 5496 CALL iso_verif_aberrant_encadre( & … … 5498 5498 /(rr(il,inb(il))+delt*fr(il,inb(il))), & 5499 5499 'cv30_yield 3921, en inb') 5500 if(iso_O18.gt.0) THEN5501 if(iso_verif_O18_aberrant_nostop( &5500 IF (iso_O18.gt.0) THEN 5501 IF (iso_verif_O18_aberrant_nostop( & 5502 5502 (xt(iso_HDO,il,inb(il))+delt*fxt(iso_HDO,il,inb(il))) & 5503 5503 /(rr(il,inb(il))+delt*fr(il,inb(il))), & 5504 5504 (xt(iso_O18,il,inb(il))+delt*fxt(iso_O18,il,inb(il))) & 5505 5505 /(rr(il,inb(il))+delt*fr(il,inb(il))), & 5506 'cv30_yield 3921O18, en inb'). eq.1) THEN5506 'cv30_yield 3921O18, en inb').EQ.1) THEN 5507 5507 WRITE(*,*) 'il,inb(il)=',il,inb(il) 5508 5508 k_tmp=0.1*ment(il,inb(il),inb(il))/(ph(il,inb(il))-ph(il,inb(il)+1)) … … 5519 5519 endif !if (iso_O18.gt.0) THEN 5520 5520 endif !if (iso_HDO.gt.0) THEN 5521 if ((iso_HDO.gt.0).and. &5521 IF ((iso_HDO.gt.0).AND. & 5522 5522 (rr(il,inb(il)-1)+delt*fr(il,inb(il)-1).gt.ridicule)) THEN 5523 5523 CALL iso_verif_aberrant_encadre( & … … 5526 5526 /(rr(il,inb(il)-1)+delt*fr(il,inb(il)-1)), & 5527 5527 'cv30_yield 3921b, en inb-1') 5528 if(iso_O18.gt.0) THEN5528 IF (iso_O18.gt.0) THEN 5529 5529 CALL iso_verif_O18_aberrant( & 5530 5530 (xt(iso_HDO,il,inb(il)-1)+delt*fxt(iso_HDO,il,inb(il)-1)) & … … 5543 5543 xtnew(ixt)=xt(ixt,il,inb(il))+delt*fxt(ixt,il,inb(il)) 5544 5544 enddo 5545 if(iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) &5546 . eq.1) THEN5545 IF (iso_verif_tracpos_choix_nostop(xtnew,'cv30_yield 4492',1e-5) & 5546 .EQ.1) THEN 5547 5547 WRITE(*,*) 'il,i=',il,i 5548 5548 endif … … 5615 5615 fr(il, i) = bsum(il)/csum(il) 5616 5616 #ifdef ISO 5617 if(abs(csum(il)).gt.0.0) THEN5617 IF (abs(csum(il)).gt.0.0) THEN 5618 5618 do ixt=1,ntraciso 5619 5619 fxt(ixt,il,i)=bxtsum(ixt,il)/csum(il) 5620 5620 enddo 5621 5621 else !if (frsum(il).gt.ridicule) THEN 5622 if(abs(frsum(il)).gt.0.0) THEN5622 IF (abs(frsum(il)).gt.0.0) THEN 5623 5623 do ixt=1,ntraciso 5624 5624 fxt(ixt,il,i)=fr(il,i)*fxtsum(ixt,il)/frsum(il) 5625 5625 enddo 5626 5626 else !if (abs(frsum(il)).gt.0.0) THEN 5627 if(abs(fr(il,i))*delt.gt.ridicule) THEN5627 IF (abs(fr(il,i))*delt.gt.ridicule) THEN 5628 5628 WRITE(*,*) 'cv30_yield 4048: fr(il,i)=',fr(il,i) 5629 5629 stop … … 5632 5632 fxt(ixt,il,i)=0.0 5633 5633 enddo 5634 if(iso_eau.gt.0) THEN5634 IF (iso_eau.gt.0) THEN 5635 5635 fxt(iso_eau,il,i)=1.0 5636 5636 endif … … 5662 5662 ! : il,i,inb(il),ncum 5663 5663 ! WRITE(*,*) 'cv30_routines 3974' 5664 if(iso_eau.gt.0) THEN5664 IF (iso_eau.gt.0) THEN 5665 5665 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 5666 5666 fr(il,i),'cv30_yield 3830',errmax,errmaxrel) 5667 5667 endif !if (iso_eau.gt.0) THEN 5668 5668 ! WRITE(*,*) 'cv30_routines 3979' 5669 if ((iso_HDO.gt.0).and. &5669 IF ((iso_HDO.gt.0).AND. & 5670 5670 (delt*fr(il,i).gt.ridicule)) THEN 5671 if(iso_verif_aberrant_enc_nostop( &5671 IF (iso_verif_aberrant_enc_nostop( & 5672 5672 fxt(iso_HDO,il,i)/fr(il,i), & 5673 'cv30_yield 3834'). eq.1) THEN5674 if(fr(il,i).gt.ridicule*1e5) THEN5673 'cv30_yield 3834').EQ.1) THEN 5674 IF (fr(il,i).gt.ridicule*1e5) THEN 5675 5675 WRITE(*,*) 'il,i,icb(il)=',il,i,icb(il) 5676 5676 WRITE(*,*) 'frsum(il)=',frsum(il) … … 5685 5685 endif !if (iso_verif_aberrant_enc_nostop 5686 5686 endif !if (iso_HDO.gt.0) THEN 5687 if ((iso_HDO.gt.0).and. &5687 IF ((iso_HDO.gt.0).AND. & 5688 5688 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5689 if(iso_verif_aberrant_enc_nostop( &5689 IF (iso_verif_aberrant_enc_nostop( & 5690 5690 (xt(iso_HDO,il,i)+delt*fxt(iso_HDO,il,i)) & 5691 5691 /(rr(il,i)+delt*fr(il,i)),'cv30_yield 3921c, dans la CL') & 5692 . eq.1) THEN5692 .EQ.1) THEN 5693 5693 WRITE(*,*) 'il,i,icb(il)=',il,i,icb(il) 5694 5694 WRITE(*,*) 'frsum(il)=',frsum(il) … … 5697 5697 endif 5698 5698 endif !if (iso_HDO.gt.0) THEN 5699 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &5699 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 5700 5700 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5701 5701 CALL iso_verif_O18_aberrant( & … … 5719 5719 do i=1,nl 5720 5720 do il=1,ncum 5721 if(iso_eau.gt.0) THEN5721 IF (iso_eau.gt.0) THEN 5722 5722 CALL iso_verif_egalite_choix(fxt(iso_eau,il,i), & 5723 5723 fr(il,i),'cv30_yield 3830',errmax,errmaxrel) 5724 5724 endif !if (iso_eau.gt.0) THEN 5725 if ((iso_HDO.gt.0).and. &5725 IF ((iso_HDO.gt.0).AND. & 5726 5726 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5727 5727 CALL iso_verif_aberrant_encadre((xt(iso_HDO,il,i) & … … 5730 5730 'cv30_yield 5710a, final') 5731 5731 endif !if (iso_HDO.gt.0) THEN 5732 if ((iso_HDO.gt.0).and.(iso_O18.gt.0).and. &5732 IF ((iso_HDO.gt.0).AND.(iso_O18.gt.0).AND. & 5733 5733 (rr(il,i)+delt*fr(il,i).gt.ridicule)) THEN 5734 5734 CALL iso_verif_O18_aberrant( & … … 5804 5804 DO k = i, nl 5805 5805 DO il = 1, ncum 5806 ! test if (i.ge.icb(il). and.i.le.inb(il).and.k.le.inb(il))5806 ! test if (i.ge.icb(il).AND.i.le.inb(il).AND.k.le.inb(il)) 5807 5807 ! THEN 5808 5808 IF (i<=inb(il) .AND. k<=inb(il)) THEN … … 6101 6101 6102 6102 #ifdef ISO 6103 useinfotrac_phy, ONLY: ntraciso=>ntiso6104 #ifdef ISOVERIF 6105 useisotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, &6103 USE infotrac_phy, ONLY: ntraciso=>ntiso 6104 #ifdef ISOVERIF 6105 USE isotopes_verif_mod, ONLY: Tmin_verif,iso_verif_aberrant, & 6106 6106 iso_verif_egalite,iso_verif_egalite_choix_nostop,iso_verif_positif_nostop, & 6107 6107 iso_verif_egalite_nostop,iso_verif_aberrant_nostop,deltaD,iso_verif_noNaN_nostop, & … … 6141 6141 REAL xtprecip(ntraciso,nloc) 6142 6142 REAL xtvprecip(ntraciso,nloc, nd+1), xtevap(ntraciso,nloc, nd) 6143 realfxt(ntraciso,nloc,nd)6144 realxtclw(ntraciso,nloc,nd)6143 REAL fxt(ntraciso,nloc,nd) 6144 REAL xtclw(ntraciso,nloc,nd) 6145 6145 REAL xtwdtraina(ntraciso,nloc, nd) 6146 6146 #endif … … 6170 6170 ! RomP <<< 6171 6171 #ifdef ISO 6172 realxtprecip1(ntraciso,len)6173 realfxt1(ntraciso,len,nd)6174 realxtVPrecip1(ntraciso,len,nd+1),xtevap1(ntraciso,len, nd)6172 REAL xtprecip1(ntraciso,len) 6173 REAL fxt1(ntraciso,len,nd) 6174 REAL xtVPrecip1(ntraciso,len,nd+1),xtevap1(ntraciso,len, nd) 6175 6175 REAL xtwdtraina1(ntraciso,len, nd) 6176 6176 REAL xtclw1(ntraciso,len, nd) … … 6180 6180 INTEGER i, k, j 6181 6181 #ifdef ISO 6182 integerixt6182 INTEGER ixt 6183 6183 #endif 6184 6184 6185 6185 #ifdef DIAGISO 6186 realwater(nloc,nd)6187 realxtwater(ntraciso,nloc,nd)6188 realqp(nloc,nd),xtp(ntraciso,nloc,nd)6189 realfq_detrainement(nloc,nd)6190 realf_detrainement(nloc,nd)6191 realq_detrainement(nloc,nd)6192 realfq_ddft(nloc,nd)6193 realfq_fluxmasse(nloc,nd)6194 realfq_evapprecip(nloc,nd)6195 realfxt_detrainement(ntraciso,nloc,nd)6196 realxt_detrainement(ntraciso,nloc,nd)6197 realfxt_ddft(ntraciso,nloc,nd)6198 realfxt_fluxmasse(ntraciso,nloc,nd)6199 realfxt_evapprecip(ntraciso,nloc,nd)6200 6201 realwater1(len,nd)6202 realxtwater1(ntraciso,len,nd)6203 realqp1(len,nd),xtp1(ntraciso,len,nd)6204 realfq_detrainement1(len,nd)6205 realf_detrainement1(len,nd)6206 realq_detrainement1(len,nd)6207 realfq_ddft1(len,nd)6208 realfq_fluxmasse1(len,nd)6209 realfq_evapprecip1(len,nd)6210 realfxt_detrainement1(ntraciso,len,nd)6211 realxt_detrainement1(ntraciso,len,nd)6212 realfxt_ddft1(ntraciso,len,nd)6213 realfxt_fluxmasse1(ntraciso,len,nd)6214 realfxt_evapprecip1(ntraciso,len,nd)6186 REAL water(nloc,nd) 6187 REAL xtwater(ntraciso,nloc,nd) 6188 REAL qp(nloc,nd),xtp(ntraciso,nloc,nd) 6189 REAL fq_detrainement(nloc,nd) 6190 REAL f_detrainement(nloc,nd) 6191 REAL q_detrainement(nloc,nd) 6192 REAL fq_ddft(nloc,nd) 6193 REAL fq_fluxmasse(nloc,nd) 6194 REAL fq_evapprecip(nloc,nd) 6195 REAL fxt_detrainement(ntraciso,nloc,nd) 6196 REAL xt_detrainement(ntraciso,nloc,nd) 6197 REAL fxt_ddft(ntraciso,nloc,nd) 6198 REAL fxt_fluxmasse(ntraciso,nloc,nd) 6199 REAL fxt_evapprecip(ntraciso,nloc,nd) 6200 6201 REAL water1(len,nd) 6202 REAL xtwater1(ntraciso,len,nd) 6203 REAL qp1(len,nd),xtp1(ntraciso,len,nd) 6204 REAL fq_detrainement1(len,nd) 6205 REAL f_detrainement1(len,nd) 6206 REAL q_detrainement1(len,nd) 6207 REAL fq_ddft1(len,nd) 6208 REAL fq_fluxmasse1(len,nd) 6209 REAL fq_evapprecip1(len,nd) 6210 REAL fxt_detrainement1(ntraciso,len,nd) 6211 REAL xt_detrainement1(ntraciso,len,nd) 6212 REAL fxt_ddft1(ntraciso,len,nd) 6213 REAL fxt_fluxmasse1(ntraciso,len,nd) 6214 REAL fxt_evapprecip1(ntraciso,len,nd) 6215 6215 #endif 6216 6216 … … 6345 6345 6346 6346 ! inputs: 6347 integerncum, nd, nloc6348 integericb(nloc), inb(nloc)6349 realcape(nloc)6350 realclw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)6351 integernk(nloc)6347 INTEGER ncum, nd, nloc 6348 INTEGER icb(nloc), inb(nloc) 6349 REAL cape(nloc) 6350 REAL clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd) 6351 INTEGER nk(nloc) 6352 6352 ! inouts: 6353 realep(nloc,nd)6354 realhp(nloc,nd)6353 REAL ep(nloc,nd) 6354 REAL hp(nloc,nd) 6355 6355 ! outputs ou local 6356 realepmax_diag(nloc)6356 REAL epmax_diag(nloc) 6357 6357 ! locals 6358 integer i,k6359 realhp_bak(nloc,nd)6358 INTEGER i,k 6359 REAL hp_bak(nloc,nd) 6360 6360 CHARACTER (LEN=20) :: modname='cv30_epmax_fn_cape' 6361 6361 CHARACTER (LEN=80) :: abort_message … … 6363 6363 ! on recalcule ep et hp 6364 6364 6365 if(coef_epmax_cape.gt.1e-12) THEN6365 IF (coef_epmax_cape.gt.1e-12) THEN 6366 6366 do i=1,ncum 6367 6367 epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i)) … … 6386 6386 do k=minorig+1,nl 6387 6387 do i=1,ncum 6388 if((k.ge.icb(i)).and.(k.le.inb(i)))THEN6388 IF((k.ge.icb(i)).AND.(k.le.inb(i)))THEN 6389 6389 hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k) 6390 6390 endif … … 6394 6394 do i=1,ncum 6395 6395 do k=1,nl 6396 if(abs(hp_bak(i,k)-hp(i,k)).gt.0.01) THEN6396 IF (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) THEN 6397 6397 WRITE(*,*) 'i,k=',i,k 6398 6398 WRITE(*,*) 'coef_epmax_cape=',coef_epmax_cape
Note: See TracChangeset
for help on using the changeset viewer.
