Changeset 1124
- Timestamp:
- Dec 10, 2013, 8:06:53 AM (11 years ago)
- Location:
- trunk/LMDZ.MARS
- Files:
-
- 5 edited
-
README (modified) (1 diff)
-
libf/phymars/nlte_aux.F (modified) (10 diffs)
-
libf/phymars/nlte_calc.F (modified) (33 diffs)
-
libf/phymars/nlte_tcool.F (modified) (24 diffs)
-
libf/phymars/physiq.F (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/README
r1119 r1124 1958 1958 - Bug fix: Sun-Mars distance was not correctly taken into account in the 1959 1959 solvarmod==1 (daily varying realistic EUV input) case. 1960 1961 == 10/12/2013 == FGG 1962 - Improved 15um cooling routines, with also better handling of errors. -
trunk/LMDZ.MARS/libf/phymars/nlte_aux.F
r769 r1124 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 ! Fast scheme for NLTE cooling rates at 15um by CO2 in a Martian GCM ! 3 ! Version dlvr11_03. 2012. ! 4 ! Software written and provided by IAA/CSIC, Granada, Spain, ! 5 ! under ESA contract "Mars Climate Database and Physical Models" ! 6 ! Person of contact: Miguel Angel Lopez Valverde valverde@iaa.es ! 7 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1 8 c********************************************************************** 2 9 … … 198 205 c *********** 199 206 200 do 1, k=1,nbox _max207 do 1, k=1,nbox 201 208 temperatura = xtemp(k) 202 209 if (abs(xtemp(k)-thist(1)).le.0.01d0) then … … 204 211 elseif (abs(xtemp(k)-thist(nhist)).le.0.01d0) then 205 212 temperatura=thist(nhist) 213 elseif (xtemp(k).lt.thist(1)) then 214 temperatura=thist(1) 215 write (*,*) ' WARNING intershphunt/ Too low atmosph Tk:' 216 write (*,*) ' WARNING k,xtemp = ', k,xtemp(k) 217 write (*,*) ' Minimum Tk in histogram used : ', thist(1) 218 elseif (xtemp(k).gt.thist(nhist)) then 219 temperatura=thist(nhist) 220 write (*,*) ' WARNING intershphunt/ Very high atmosph Tk:' 221 write (*,*) ' WARNING k,xtemp = ', k,xtemp(k) 222 write (*,*) ' Max Tk in histogram used : ', thist(nhist) 206 223 endif 207 224 call huntdp ( thist,nhist, temperatura, i ) … … 209 226 write (*,*) ' HUNT/ Limits input grid:', 210 227 @ thist(1),thist(nhist) 211 write (*,*) ' HUNT/ location in newgrid:', xtemp(k)228 write (*,*) ' HUNT/ location in grid:', xtemp(k) 212 229 stop ' INTERSHP/ Interpolation error. T out of Histogram.' 213 230 endif … … 253 270 elseif (abs(xtemp(k)-thist(nhist)).le.0.01d0) then 254 271 temperatura=thist(nhist) 272 elseif (xtemp(k).lt.thist(1)) then 273 temperatura=thist(1) 274 write (*,*) ' WARNING interstrhunt/ Too low atmosph Tk:' 275 write (*,*) ' WARNING k,xtemp(k) = ', k,xtemp(k) 276 write (*,*) ' Minimum Tk in histogram used : ', thist(1) 277 elseif (xtemp(k).gt.thist(nhist)) then 278 temperatura=thist(nhist) 279 write (*,*) ' WARNING interstrhunt/ Very high atmosph Tk:' 280 write (*,*) ' WARNING k,xtemp(k) = ', k,xtemp(k) 281 write (*,*) ' Max Tk in histogram used : ', thist(nhist) 255 282 endif 256 283 call huntdp ( thist,nhist, temperatura, i ) 257 284 if ( i.eq.0 .or. i.eq.nhist ) then 258 write(*,*)'HUNT/ Limits input grid:',thist(1),thist(nhist) 259 write(*,*)'HUNT/ location in new grid:',xtemp(k) 285 write(*,*)'HUNT/ Limits input grid:', 286 $ thist(1),thist(nhist) 287 write(*,*)'HUNT/ location in grid:',xtemp(k) 260 288 stop'INTERSTR/1/ Interpolation error. T out of Histogram.' 261 289 endif … … 271 299 elseif (abs(ts-thist(nhist)).le.0.01d0) then 272 300 temperatura=thist(nhist) 301 elseif (ts.lt.thist(1)) then 302 temperatura=thist(1) 303 write (*,*) ' WARNING interstrhunt/ Too low atmosph Tk:' 304 write (*,*) ' WARNING ts = ', temperatura 305 write (*,*) ' Minimum Tk in histogram used : ', thist(1) 306 elseif (ts.gt.thist(nhist)) then 307 temperatura=thist(nhist) 308 write (*,*) ' WARNING interstrhunt/ Very high atmosph Tk:' 309 write (*,*) ' WARNING ts = ', temperatura 310 write (*,*) ' Max Tk in histogram used : ', thist(nhist) 273 311 endif 274 312 call huntdp ( thist,nhist, temperatura, i ) … … 276 314 write (*,*) ' HUNT/ Limits input grid:', 277 315 @ thist(1),thist(nhist) 278 write (*,*) ' HUNT/ location in newgrid:', ts316 write (*,*) ' HUNT/ location in grid:', ts 279 317 stop ' INTERSTR/2/ Interpolat error. T out of Histogram.' 280 318 endif … … 2313 2351 2314 2352 c local variables 2315 integer j, r, mm 2316 real*8 xx 2353 integer j, r 2317 2354 2318 2355 c *************** … … 2350 2387 2351 2388 c local variables 2352 integer j, r, mm2389 integer j, r 2353 2390 real*8 xx 2354 2391 … … 2369 2406 endif 2370 2407 2371 do j= 1,mm_stored(ihist)2408 do j=mm_stored(ihist),1,-1 2372 2409 read(3,*) thist_stored(ihist,j) 2373 2410 do r=1,nbox_stored(ihist) -
trunk/LMDZ.MARS/libf/phymars/nlte_calc.F
r757 r1124 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 ! Fast scheme for NLTE cooling rates at 15um by CO2 in a Martian GCM ! 3 ! Version dlvr11_03. 2012. ! 4 ! Software written and provided by IAA/CSIC, Granada, Spain, ! 5 ! under ESA contract "Mars Climate Database and Physical Models" ! 6 ! Person of contact: Miguel Angel Lopez Valverde valverde@iaa.es ! 7 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1 8 c********************************************************************** 2 9 c … … 19 26 20 27 c*********************************************************************** 21 subroutine MZESC110 ( nl_cts_real, nzy_cts_real)28 subroutine MZESC110 (ig,nl_cts_real, nzy_cts_real,ierr,varerr) 22 29 c*********************************************************************** 23 30 … … 30 37 c arguments 31 38 integer nl_cts_real, nzy_cts_real ! i 39 integer ig 32 40 33 41 c old arguments … … 36 44 37 45 c local variables and constants 38 integer i, i n, ir, iaquiHIST , iaquiZ39 integer ib,isot40 real*8 41 real*8 42 real*8 43 real*8 44 real*8 45 real*8 46 real*8 47 real*8 48 real*8 49 real*8 50 real*8 46 integer i, iaquiHIST , iaquiZ 47 integer isot 48 real*8 argumento 49 real*8 tauinf(nl_cts) 50 real*8 con(nzy_cts), coninf 51 real*8 c1, c2 , ccc 52 real*8 t1, t2 53 real*8 p1, p2 54 real*8 mr1, mr2 55 real*8 st1, st2 56 real*8 c1box(nbox_max), c2box(nbox_max) 57 real*8 ff ! to avoid too small numbers 58 real*8 st, beta, ts 51 59 real*8 tyd(nzy_cts) 52 real*8 53 real*8 54 real*8 60 real*8 correc 61 real*8 deltanudbl, deltazdbl 62 real*8 yy 55 63 56 64 c external function 57 external 58 real*8 59 60 c*********************************************************************** 61 62 c 63 ib = 1 65 external we_clean 66 real*8 we_clean 67 68 c*********************************************************************** 69 ierr = 0 70 varerr = 0.d0 71 c 64 72 beta = 1.8d5 65 73 ibcode1 = '1' … … 77 85 mr_cts(i) = dble(co2y_cts(i)/nty_cts(i)) 78 86 end do 79 coninf = dble( con(nzy_cts_real) / 80 @ log( con(nzy_cts_real-1) / con(nzy_cts_real) ) ) 81 ! Correccion pequeña para la FB, nos la saltamos 82 !call mztf_correccion_cts ( coninf, con, ib ) 83 87 if ( con(nzy_cts_real) .le. 0.0d0 ) then 88 ierr = 33 89 varerr = con(nzy_cts_real) 90 return 91 elseif ( con(nzy_cts_real-1) .le. con(nzy_cts_real) ) then 92 write (*,*) ' WARNING in MZESC110 ' 93 write (*,*) ' [CO2] growing with altitude at TOA.' 94 write (*,*) ' [CO2] @ TOA = ', con(nzy_cts_real) 95 coninf = dble( con(nzy_cts_real) ) 96 else 97 coninf = dble( con(nzy_cts_real) / 98 @ log( con(nzy_cts_real-1) / con(nzy_cts_real) ) ) 99 endif 84 100 ccc 85 101 call gethist_03 ( 1 ) … … 187 203 argumento = eqw / deltanudbl 188 204 tauinf(i) = dexp( - argumento ) 189 190 205 if (i.eq.nl_cts_real) then 191 206 taustar11_cts(i) = 0.0d0 … … 223 238 224 239 c local variables and constants 225 integer i, in, ir, iaquiHIST , iaquiZ240 integer i, in, ir, iaquiHIST , iaquiZ 226 241 integer ib, isot 227 real*8 228 real*8 229 real*8 230 real*8 231 real*8 232 real*8 233 real*8 234 real*8 235 real*8 236 real*8 237 real*8 238 real*8 239 real*8 zld(nl), zyd(nzy), deltazdbl240 real*8 241 real*8 242 real*8 tau(nl,nl), argumento 243 real*8 tauinf(nl) 244 real*8 con(nzy), coninf 245 real*8 c1, c2 246 real*8 t1, t2 247 real*8 p1, p2 248 real*8 mr1, mr2 249 real*8 st1, st2 250 real*8 c1box(nbox_max), c2box(nbox_max) 251 real*8 ff ! to avoid too small numbers 252 real*8 tvtbs(nzy) 253 real*8 st, beta, ts 254 real*8 zld(nl), zyd(nzy), deltazdbl 255 real*8 correc 256 real*8 deltanudbl 242 257 real*8 maxtau, yy 243 258 … … 248 263 c*********************************************************************** 249 264 265 ierr = 0 266 varerr = 0.d0 250 267 c 251 268 ib = 1 … … 271 288 mr(i) = dble(co2y(i)/nty(i)) 272 289 end do 273 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 290 if ( con(nzy) .le. 0.0d0 ) then 291 ierr = 43 292 varerr = con(nzy) 293 return 294 elseif ( con(nzy-1) .le. con(nzy) ) then 295 write (*,*) ' WARNING in MZTUD110 ' 296 write (*,*) ' [CO2] grows with height at CurtisMatrix top.' 297 write (*,*) ' [CO2] @ top = ', con(nzy) 298 coninf = dble( con(nzy) ) 299 else 300 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 301 endif 274 302 call mztf_correccion ( coninf, con, ib ) 275 303 … … 294 322 end do 295 323 call interstrhunt (iaquiHIST, st2,t2,ka,ta) 296 324 ! Check interpolation errors : 297 325 if (c2.le.0.0d0) then 298 ierr= 15326 ierr=45 299 327 varerr=c2 300 328 return 301 329 elseif (p2.le.0.0d0) then 302 ierr= 16330 ierr=46 303 331 varerr=p2 304 332 return 305 333 elseif (mr2.le.0.0d0) then 306 ierr= 17334 ierr=47 307 335 varerr=mr2 308 336 return 309 337 elseif (t2.le.0.0d0) then 310 ierr= 18338 ierr=48 311 339 varerr=t2 312 340 return 313 341 elseif (st2.le.0.0d0) then 314 ierr= 19342 ierr=49 315 343 varerr=st2 316 344 return … … 337 365 c1box(kr) = c1 * ka(kr) * deltazdbl 338 366 end do 367 ! Check interpolation errors : 368 if (c1.le.0.0d0) then 369 ierr=75 370 varerr=c1 371 return 372 elseif (p1.le.0.0d0) then 373 ierr=76 374 varerr=p1 375 return 376 elseif (mr1.le.0.0d0) then 377 ierr=77 378 varerr=mr1 379 return 380 elseif (t1.le.0.0d0) then 381 ierr=78 382 varerr=t1 383 return 384 elseif (st1.le.0.0d0) then 385 ierr=79 386 varerr=st1 387 return 388 endif 389 ! 339 390 c1 = c1 * st1 * deltazdbl 340 391 aa = aa + ( p1*mr1*(c1*ff) + p2*mr2*(c2*ff)) / 2.d0 … … 549 600 end do 550 601 if (maxtau .gt. 1.0d0) then 551 ierr = 13602 ierr = 42 552 603 varerr = maxtau 553 604 return … … 673 724 ! local variables 674 725 675 real*8 cax1(nl,nl) 676 real*8 v1(nl), cm_factor, vc_factor 677 real nuaux1, nuaux2, nuaux3 678 real*8 faux2,faux3, daux2,daux3 726 real*8 cax1(nl,nl) 727 real*8 v1(nl), cm_factor, vc_factor 728 real nuaux1, nuaux2, nuaux3 729 real*8 faux2,faux3, daux2,daux3 730 real*8 varerr 679 731 680 732 integer i,j,ik,ib 733 integer ierr 681 734 682 735 ************************************************************************ … … 700 753 cax1(1:nl,1:nl)=0.d0 701 754 ! call zerom (cax1,nl) 702 call MZTUD121 ( cax1,v1, ib ) 755 call MZTUD121 ( cax1,v1, ib, ierr, varerr ) 756 if (ierr .gt. 0) call ERRORS (ierr,varerr) 703 757 704 758 do i=1,nl … … 734 788 735 789 c*********************************************************************** 736 subroutine MZTUD121 ( cf,vc, ib )790 subroutine MZTUD121 ( cf,vc, ib, ierr, varerr ) 737 791 c*********************************************************************** 738 792 … … 745 799 746 800 c arguments 747 real*8 cf(nl,nl) ! o. 748 real*8 vc(nl) ! o 749 integer ib ! i 801 real*8 cf(nl,nl) ! o 802 real*8 vc(nl) ! o 803 integer ib ! i 804 integer ierr ! o 805 real*8 varerr ! o 750 806 751 807 752 808 c local variables and constants 753 integer i, in, ir, iaquiHIST, iaquiZ 754 integer nmu 755 parameter (nmu = 8) 756 real*8 tau(nl,nl), argumento, deltazdbl 757 real*8 tauinf(nl) 758 real*8 con(nzy), coninf 759 real*8 c1, c2 760 real*8 t1, t2 761 real*8 p1, p2 762 real*8 mr1, mr2 763 real*8 st1, st2 764 real*8 c1box(70), c2box(70) 765 real*8 ff ! to avoid too small numbers 766 real*8 tvtbs(nzy) 767 real*8 st, beta, ts 768 769 real*8 zld(nl), zyd(nzy) 770 real*8 correc 771 real*8 deltanudbl 772 integer isot 809 integer i, in, ir, iaquiHIST, iaquiZ 810 integer isot 811 real*8 tau(nl,nl), argumento, deltazdbl 812 real*8 tauinf(nl) 813 real*8 con(nzy), coninf 814 real*8 c1, c2 815 real*8 t1, t2 816 real*8 p1, p2 817 real*8 mr1, mr2 818 real*8 st1, st2 819 real*8 c1box(nbox_max), c2box(nbox_max) 820 real*8 ff ! to avoid too small numbers 821 real*8 tvtbs(nzy) 822 real*8 st, beta, ts 823 real*8 zld(nl), zyd(nzy) 824 real*8 correc 825 real*8 deltanudbl 773 826 real*8 yy 774 827 … … 781 834 101 format(i1) 782 835 c*********************************************************************** 836 837 ierr = 0 838 varerr = 0.d0 783 839 784 840 c some values … … 809 865 end do 810 866 811 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 867 if ( con(nzy) .le. 0.0d0 ) then 868 ierr = 83 869 varerr = con(nzy) 870 return 871 elseif ( con(nzy-1) .le. con(nzy) ) then 872 write (*,*) ' WARNING in MZTUD121 ' 873 write (*,*) ' [CO2] grows with height at CurtisMatrix top.' 874 write (*,*) ' [CO2] @ top = ', con(nzy) 875 coninf = dble( con(nzy) ) 876 else 877 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 878 endif 812 879 call mztf_correccion ( coninf, con, ib ) 813 880 … … 852 919 c1box(kr) = c1 * ka(kr) * deltazdbl 853 920 end do 921 ! Check interpolation errors : 922 if (c1.le.0.0d0) then 923 ierr=85 924 varerr=c1 925 return 926 elseif (p1.le.0.0d0) then 927 ierr=86 928 varerr=p1 929 return 930 elseif (mr1.le.0.0d0) then 931 ierr=87 932 varerr=mr1 933 return 934 elseif (t1.le.0.0d0) then 935 ierr=88 936 varerr=t1 937 return 938 elseif (st1.le.0.0d0) then 939 ierr=89 940 varerr=st1 941 return 942 endif 943 ! 854 944 c1 = c1 * st1 * deltazdbl 855 945 aa = aa + ( p1*mr1*(c1*ff) + p2*mr2*(c2*ff)) / 2.d0 … … 1179 1269 1180 1270 c local variables 1181 integer i1271 integer i,ierr 1182 1272 real*8 factor0200, factor0220, factor1000 1183 1273 real*8 aux_0200(nl), aux2_0200(nl) 1184 1274 real*8 aux_0220(nl), aux2_0220(nl) 1185 1275 real*8 aux_1000(nl), aux2_1000(nl) 1276 real*8 varerr 1186 1277 1187 1278 c*********************************************************************** … … 1193 1284 call zero2v(aux_1000,aux2_1000, nl) 1194 1285 1195 call MZESC121sub (aux_0200,aux2_0200, 2 ) 1196 call MZESC121sub (aux_0220,aux2_0220, 3 ) 1197 call MZESC121sub (aux_1000,aux2_1000, 4 ) 1286 call MZESC121sub (aux_0200,aux2_0200, 2 , ierr, varerr) 1287 if (ierr .gt. 0) call ERRORS (ierr,varerr) 1288 call MZESC121sub (aux_0220,aux2_0220, 3 , ierr, varerr) 1289 if (ierr .gt. 0) call ERRORS (ierr,varerr) 1290 call MZESC121sub (aux_1000,aux2_1000, 4 , ierr, varerr) 1291 if (ierr .gt. 0) call ERRORS (ierr,varerr) 1198 1292 1199 1293 factor0220 = 1.d0 … … 1218 1312 c*********************************************************************** 1219 1313 1220 subroutine MZESC121sub (taustar,tauinf, ib )1314 subroutine MZESC121sub (taustar,tauinf, ib, ierr, varerr ) 1221 1315 1222 1316 c*********************************************************************** … … 1230 1324 1231 1325 c arguments 1232 real*8 taustar(nl) ! o 1233 real*8 tauinf(nl) ! o 1234 integer ib ! i 1326 real*8 taustar(nl) ! o 1327 real*8 tauinf(nl) ! o 1328 integer ib ! i 1329 integer ierr ! o 1330 real*8 varerr ! o 1235 1331 1236 1332 1237 1333 c local variables and constants 1238 integer i, iaquiHIST, iaquiZ, isot1239 real*8 1240 real*8 1241 real*8 1242 real*8 1243 real*8 1244 real*8 1245 real*8 1246 real*8 1247 real*8 1248 real*8 1249 real*8 zld(nl), zyd(nzy)1250 real*8 1251 real*8 1334 integer i, iaquiHIST, iaquiZ, isot 1335 real*8 con(nzy), coninf 1336 real*8 c1, c2, ccc 1337 real*8 t1, t2 1338 real*8 p1, p2 1339 real*8 mr1, mr2 1340 real*8 st1, st2 1341 real*8 c1box(70), c2box(70) 1342 real*8 ff ! to avoid too small numbers 1343 real*8 tvtbs(nzy) 1344 real*8 st, beta, ts 1345 real*8 zld(nl), zyd(nzy) 1346 real*8 correc 1347 real*8 deltanudbl, deltazdbl 1252 1348 real*8 yy 1253 1349 1254 1350 c external function 1255 1351 external we_clean 1256 real*8 we_clean1352 real*8 we_clean 1257 1353 1258 1354 c formats … … 1261 1357 c*********************************************************************** 1262 1358 1359 ierr = 0 1360 varerr = 0.d0 1263 1361 c 1264 1362 beta = 1.8d5 … … 1285 1383 mr(i) = dble(co2y(i)/nty(i)) 1286 1384 end do 1287 1288 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 1385 if ( con(nzy) .le. 0.0d0 ) then 1386 ierr = 63 1387 varerr = con(nzy) 1388 return 1389 elseif ( con(nzy-1) .le. con(nzy) ) then 1390 write (*,*) ' WARNING in MZESC121sub ' 1391 write (*,*) ' [CO2] grows with height at CurtisMatrix top.' 1392 write (*,*) ' [CO2] @ top = ', con(nzy) 1393 coninf = dble( con(nzy) ) 1394 else 1395 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 1396 endif 1289 1397 call mztf_correccion ( coninf, con, ib ) 1290 1398 … … 1309 1417 end do 1310 1418 call interstrhunt (iaquiHIST, st2,t2,ka,ta) 1419 ! Check interpolation errors : 1420 if (c2.le.0.0d0) then 1421 ierr=65 1422 varerr=c2 1423 return 1424 elseif (p2.le.0.0d0) then 1425 ierr=66 1426 varerr=p2 1427 return 1428 elseif (mr2.le.0.0d0) then 1429 ierr=67 1430 varerr=mr2 1431 return 1432 elseif (t2.le.0.0d0) then 1433 ierr=68 1434 varerr=t2 1435 return 1436 elseif (st2.le.0.0d0) then 1437 ierr=69 1438 varerr=st2 1439 return 1440 endif 1441 ! 1311 1442 aa = p2 * coninf * mr2 * (st2 * ff) 1312 1443 cc = coninf * st2 … … 1401 1532 1402 1533 1403 ! arguments1404 1534 integer ierr 1405 1535 real*8 varerr … … 1448 1578 1449 1579 c*********************************************************************** 1450 c mztf.f1451 c***********************************************************************1452 1580 1453 1581 subroutine MZTVC121sub ( vc, ib, ierr, varerr ) … … 1463 1591 1464 1592 c arguments 1465 real*8 1466 integer 1467 integer ierr! o1468 real*8 varerr! o1593 real*8 vc(nl) ! o 1594 integer ib ! i 1595 integer ierr ! o 1596 real*8 varerr ! o 1469 1597 1470 1598 c local variables and constants 1471 integer i, in, ir, iaquiHIST , iaquiZ, isot 1472 integer nmu 1473 parameter (nmu = 8) 1474 real*8 tau(nl,nl), argumento 1475 real*8 con(nzy), coninf 1476 real*8 c1, c2 1477 real*8 t1, t2 1478 real*8 p1, p2 1479 real*8 mr1, mr2 1480 real*8 st1, st2 1481 real*8 c1box(70), c2box(70) 1482 real*8 ff ! to avoid too small numbers 1483 real*8 tvtbs(nzy) 1484 real*8 st, beta, ts 1485 real*8 zld(nl), zyd(nzy), deltazdbl 1486 real*8 correc 1487 real*8 deltanudbl, pideltanu,pi 1488 real*8 yy 1489 real*8 minvc, maxtau 1599 integer i, in, ir, iaquiHIST , iaquiZ, isot 1600 real*8 tau(nl,nl), argumento 1601 real*8 con(nzy), coninf 1602 real*8 c1, c2 1603 real*8 t1, t2 1604 real*8 p1, p2 1605 real*8 mr1, mr2 1606 real*8 st1, st2 1607 real*8 c1box(70), c2box(70) 1608 real*8 ff ! to avoid too small numbers 1609 real*8 tvtbs(nzy) 1610 real*8 st, beta, ts 1611 real*8 zld(nl), zyd(nzy), deltazdbl 1612 real*8 correc 1613 real*8 deltanudbl, pideltanu,pi 1614 real*8 yy 1615 real*8 minvc, maxtau 1490 1616 1491 1617 c external function 1492 external 1493 real*8 1618 external we_clean 1619 real*8 we_clean 1494 1620 1495 1621 c formats … … 1497 1623 1498 1624 c*********************************************************************** 1499 1625 1626 ierr = 0 1627 varerr = 0.d0 1500 1628 c 1501 1629 pi=3.141592 … … 1527 1655 end do 1528 1656 1529 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 1657 if ( con(nzy) .le. 0.0d0 ) then 1658 ierr = 53 1659 varerr = con(nzy) 1660 return 1661 elseif ( con(nzy-1) .le. con(nzy) ) then 1662 write (*,*) ' WARNING in MZTVC121sub ' 1663 write (*,*) ' [CO2] grows with height at CurtisMatrix top.' 1664 write (*,*) ' [CO2] @ top = ', con(nzy) 1665 coninf = dble( con(nzy) ) 1666 else 1667 coninf = dble( con(nzy) / log( con(nzy-1) / con(nzy) ) ) 1668 endif 1530 1669 call mztf_correccion ( coninf, con, ib ) 1531 1670 … … 1557 1696 ! Check interpolation errors : 1558 1697 if (c1.le.0.0d0) then 1559 ierr= 151698 ierr=55 1560 1699 varerr=c1 1561 1700 return 1562 1701 elseif (p1.le.0.0d0) then 1563 ierr= 161702 ierr=56 1564 1703 varerr=p1 1565 1704 return 1566 1705 elseif (mr1.le.0.0d0) then 1567 ierr= 171706 ierr=57 1568 1707 varerr=mr1 1569 1708 return 1570 1709 elseif (t1.le.0.0d0) then 1571 ierr= 181710 ierr=58 1572 1711 varerr=t1 1573 1712 return 1574 1713 elseif (st1.le.0.0d0) then 1575 ierr= 191714 ierr=59 1576 1715 varerr=st1 1577 1716 return … … 1656 1795 end do 1657 1796 if (maxtau .gt. 1.0d0) then 1658 ierr = 131797 ierr = 52 1659 1798 varerr = maxtau 1660 1799 return 1661 1800 else if (minvc .lt. 0.0d0) then 1662 ierr = 141801 ierr = 51 1663 1802 varerr = minvc 1664 1803 return -
trunk/LMDZ.MARS/libf/phymars/nlte_tcool.F
r1047 r1124 1 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 ! Fast scheme for NLTE cooling rates at 15um by CO2 in a Martian GCM ! 3 ! Version dlvr11_03. 2012. ! 4 ! Software written and provided by IAA/CSIC, Granada, Spain, ! 5 ! under ESA contract "Mars Climate Database and Physical Models" ! 6 ! Person of contact: Miguel Angel Lopez Valverde valverde@iaa.es ! 7 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1 8 c********************************************************************** 2 9 c … … 6 13 c -NLTEdlvr11_CZALU_03 7 14 c -NLTEdlvr11_FB626CTS_03 15 c -NLTEdlvr11_ERRORS 8 16 c 9 17 c … … 18 26 $ p_gcm, t_gcm, z_gcm, 19 27 $ co2vmr_gcm, n2vmr_gcm, covmr_gcm, o3pvmr_gcm, 20 $ q15umco2_gcm )28 $ q15umco2_gcm , ierr, varerr) 21 29 22 30 c*********************************************************************** … … 80 88 81 89 ! From GCM's grid to NLTE's grid 82 call NLTEdlvr11_ZGRID _02(n_gcm,90 call NLTEdlvr11_ZGRID (n_gcm, 83 91 $ p_ig, t_ig, z_ig, 84 92 $ co2_ig, n2_ig, co_ig, o3p_ig, … … 91 99 92 100 ! Tstar para NLTE-CTS 93 call MZESC110 ( nl_cts_real, nzy_cts_real ) 94 95 ! 626FB C.M. 101 call MZESC110 ( ig,nl_cts_real, nzy_cts_real,ierr,varerr ) 102 if (ierr .gt. 0) call ERRORS (ierr,varerr) 103 104 ! 626FB C.M. 96 105 call leetvt 97 106 c110(1:nl,1:nl)=0.d0 … … 99 108 call zero2v (vc110,taustar11, nl) 100 109 call MZTUD110 ( ierr, varerr ) 101 if (ierr .gt. 0) goto 900110 if (ierr .gt. 0) call ERRORS (ierr,varerr) 102 111 103 112 input_cza = 0 104 call NLTEdlvr11_CZALU 113 call NLTEdlvr11_CZALU(ierr,varerr) 114 if (ierr .gt. 0) call ERRORS (ierr,varerr) 105 115 106 116 input_cza = 1 107 call NLTEdlvr11_CZALU 117 call NLTEdlvr11_CZALU(ierr,varerr) 118 if (ierr .gt. 0) call ERRORS (ierr,varerr) 108 119 109 120 ! call NLTEdlvr11_FB626CTS … … 137 148 ! hacemos la media entre hrTotal y hr110CTS : 138 149 i=nl-1 139 q15umco2_nltot(i) = 0.5 *( q15umco2_nltot(i) + hr110CTS(1) )150 q15umco2_nltot(i) = 0.5d0*( q15umco2_nltot(i) + hr110CTS(1) ) 140 151 do i=2,nl_cts_real 141 152 indice = (nl-2) + i … … 188 199 c end subroutine 189 200 return 190 191 c Error messages192 900 write (*,*) ' ERROR in MZTUD (banda 110). ierr=',ierr193 write (*,*) ' VAR available : ', varerr194 return195 196 901 write (*,*) ' ERROR in MZTVC for vc210. ierr=',ierr197 write (*,*) ' VAR available : ', varerr198 return199 200 902 write (*,*) ' ERROR in MZTVC for vc310. ierr=',ierr201 write (*,*) ' VAR available : ', varerr202 return203 204 903 write (*,*) ' ERROR in MZTVC for vc410. ierr=',ierr205 write (*,*) ' VAR available : ', varerr206 return207 208 904 write (*,*) ' ERROR in mzescape_fb ierr=',ierr209 write (*,*) ' VAR available : ', varerr210 return211 212 930 write (*,*) ' ERROR in mztvc3iso. Temp is NaN'213 write (*,*) ' ierr , VAR =', ierr, varerr214 if (ierr.eq.30) write (*,*) ' During computation of VC210.'215 if (ierr.eq.31) write (*,*) ' During computation of VC310.'216 if (ierr.eq.32) write (*,*) ' During computation of VC410.'217 return218 219 c end subroutine220 201 end 221 202 … … 223 204 c*********************************************************************** 224 205 225 subroutine NLTEdlvr11_ZGRID _02(n_gcm,206 subroutine NLTEdlvr11_ZGRID (n_gcm, 226 207 $ p_gcm, t_gcm, z_gcm, co2vmr_gcm, n2vmr_gcm, 227 208 $ covmr_gcm, o3pvmr_gcm, mmean_gcm,cpnew_gcm, … … 244 225 real cpnew_gcm(n_gcm) ! I 245 226 integer nl_cts_real, nzy_cts_real ! O 227 real zaux_gcm(n_gcm) 246 228 247 229 c local variables … … 250 232 real zmin, zmax 251 233 real mmean_nlte(n_gcm),cpnew_nlte(n_gcm) 234 real gg,masa,radio,kboltzman 252 235 253 236 c functions … … 264 247 ! Primero, construimos escala z_gcm 265 248 266 ! z_gcm(1) = zmin_gcm ! [km] 267 268 ! do iz = 2, n_gcm 269 ! meanm = ( co2vmr_gcm(iz)*44. + o3pvmr_gcm(iz)*16. 270 ! @ + n2vmr_gcm(iz)*28. + covmr_gcm(iz)*28. ) 271 ! meanm = meanm / n_avog 272 ! distancia = ( radio + z_gcm(iz-1) )*1.e5 273 ! gz = gg * masa / ( distancia * distancia ) 274 ! Hkm = 0.5*( t_gcm(iz)+t_gcm(iz-1) ) / ( meanm * gz ) 275 ! Hkm = kboltzman * Hkm *1e-5 ! [km] 276 ! z_gcm(iz) = z_gcm(iz-1) - Hkm * log( p_gcm(iz)/p_gcm(iz-1) ) 277 ! enddo 249 ! zaux_gcm(1) = z_gcm(1) ! [km] 250 ! gg=6.67259e-8 251 ! masa=6.4163e26 252 ! radio=3390. 253 ! kboltzman=1.381e-16 254 255 ! do iz = 2, n_gcm 256 ! distancia = ( radio + zaux_gcm(iz-1) )*1.e5 257 ! gz = gg * masa / ( distancia * distancia ) 258 ! Hkm = 0.5*( t_gcm(iz)+t_gcm(iz-1) ) / 259 ! $ ( mmean_gcm(iz)/6.023e23 * gz ) 260 ! Hkm = kboltzman * Hkm *1e-5 ! [km] 261 ! zaux_gcm(iz) = zaux_gcm(iz-1) - 262 ! $ Hkm * log( p_gcm(iz)/p_gcm(iz-1) ) 263 ! enddo 264 278 265 279 266 ! Segundo, definimos los límites de los 2 modelos de NLTE. … … 352 339 353 340 do i=1,nl 354 if (t(i) .gt. 400.0) then341 if (t(i) .gt. 500.0) then 355 342 write (*,*) '!!!! WARNING Temp higher than Histogram.' 356 343 write (*,*) ' Histogram will be extrapolated. ' … … 496 483 497 484 498 subroutine NLTEdlvr11_CZALU 485 subroutine NLTEdlvr11_CZALU(ierr,varerr) 499 486 500 487 c*********************************************************************** … … 506 493 include 'nlte_paramdef.h' 507 494 include 'nlte_commons.h' 495 496 497 c Arguments 498 499 integer ierr 500 real*8 varerr 508 501 509 502 … … 578 571 real*8 pl11, pl12, pl21, pl31, pl41 579 572 573 real*8 minvt11, minvt21, minvt31, minvt41 580 574 581 575 c local constants and indexes … … 596 590 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!start program 597 591 592 ierr = 0 593 varerr = 0.d0 598 594 599 595 call zero4v( aa11, aa21, aa31, aa41, nl) … … 691 687 c121(1:nl,1:nl)=0.d0 692 688 call MZESC121 693 call MZTVC121 689 call MZTVC121( ierr,varerr ) 690 if (ierr .gt. 0) call ERRORS (ierr,varerr) 694 691 695 692 endif … … 814 811 end if 815 812 816 817 ! For ITT=13,15 818 813 814 ! For ITT=13,15 819 815 a21_einst(i) = a2_010_000 * 1.8d0 / 4.d0 * taustar21(i) 820 816 a31_einst(i) = a3_010_000 * 1.8d0 / 4.d0 * taustar31(i) … … 825 821 l41 = l41 + a41_einst(i) 826 822 827 823 ! For ITT=13 828 824 if (input_cza.ge.1 .and. itt_cza.eq.13) then 829 825 a12_einst(i) = a1_020_010/3.d0 * 1.8d0/4.d0 * taustar12(i) … … 832 828 833 829 834 ! 830 ! Checking for collisional severe errors 831 if (l11 .le. 0.0d0) then 832 ierr = 21 833 varerr = l11 834 return 835 elseif (l21 .le. 0.0d0) then 836 ierr = 22 837 varerr = l21 838 return 839 elseif (l31 .le. 0.0d0) then 840 ierr = 23 841 varerr = l31 842 return 843 elseif (l41 .le. 0.0d0) then 844 ierr = 24 845 varerr = l41 846 return 847 endif 848 if (input_cza.ge.1) then 849 if (l12 .lt. 0.0d0) then 850 ierr = 25 851 varerr = l12 852 return 853 endif 854 endif 855 ! 835 856 836 857 a11(i) = gamma*nu11**3.d0 * 1.d0/2.d0 * (p11) / … … 1154 1175 if (input_cza.lt.1) then 1155 1176 1177 minvt11 = 1.d6 1178 minvt21 = 1.d6 1179 minvt31 = 1.d6 1180 minvt41 = 1.d6 1156 1181 do i=1,nl 1157 1182 pl11 = el11(i)/( gamma * nu11**3.0d0 * 1.d0/2.d0 /n10(i) ) … … 1166 1191 hr310(i) = sl310(i) -hplanck*vlight*nu31 *a31_einst(i)*pl31 1167 1192 hr410(i) = sl410(i) -hplanck*vlight*nu41 *a41_einst(i)*pl41 1193 1194 minvt11 = min( minvt11,vt11(i) ) 1195 minvt21 = min( minvt21,vt21(i) ) 1196 minvt31 = min( minvt31,vt31(i) ) 1197 minvt41 = min( minvt41,vt41(i) ) 1168 1198 enddo 1199 1200 ! Checking for errors in Tvibs 1201 if (minvt11 .le. 0.d0) then 1202 ierr = 26 1203 varerr = minvt11 1204 return 1205 elseif (minvt21 .le. 0.d0) then 1206 ierr = 27 1207 varerr = minvt21 1208 return 1209 elseif (minvt31 .le. 0.d0) then 1210 ierr = 28 1211 varerr = minvt31 1212 return 1213 elseif (minvt41 .le. 0.d0) then 1214 ierr = 29 1215 varerr = minvt41 1216 return 1217 endif 1169 1218 1170 1219 v626t1(1:nl)=vt11(1:nl) … … 1329 1378 return 1330 1379 end 1380 1381 1382 c *** Old NLTEdlvr11_ERRORS *** 1383 c 1384 c*********************************************************************** 1385 1386 1387 1388 subroutine ERRORS (ierr,varerr) 1389 1390 c*********************************************************************** 1391 1392 implicit none 1393 1394 c Arguments 1395 integer ierr 1396 real*8 varerr 1397 1398 c*************** 1399 1400 if (ierr .eq. 15) then 1401 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1402 write (*,*) ' VAR available=', varerr 1403 write (*,*) ' c2 < 0 after INTZHUNT_CTS' 1404 1405 elseif (ierr .eq. 16) then 1406 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1407 write (*,*) ' VAR available=', varerr 1408 write (*,*) ' p2 < 0 after INTZHUNT_CTS' 1409 1410 elseif (ierr .eq. 17) then 1411 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1412 write (*,*) ' VAR available=', varerr 1413 write (*,*) ' mr2 < 0 after INTZHUNT_CTS' 1414 1415 elseif (ierr .eq. 18) then 1416 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1417 write (*,*) ' VAR available=', varerr 1418 write (*,*) ' t2 < 0 after INTZHUNT_CTS' 1419 1420 elseif (ierr .eq. 19) then 1421 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1422 write (*,*) ' VAR available=', varerr 1423 write (*,*) ' st2 < 0 after INTZHUNT_CTS' 1424 1425 elseif (ierr .eq. 33) then 1426 write (*,*) ' ERROR in MZESC110. ierr=',ierr 1427 write (*,*) ' VAR available=', varerr 1428 write (*,*) ' [CO2] < 0 at TOA.' 1429 1430 elseif (ierr .eq. 42) then 1431 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1432 write (*,*) ' VAR available=', varerr 1433 write (*,*) ' Atmospheric transmittance too large. ' 1434 1435 elseif (ierr .eq. 43) then 1436 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1437 write (*,*) ' VAR available=', varerr 1438 write (*,*) ' [CO2] < 0 at CurtisMatrix top.' 1439 1440 elseif (ierr .eq. 45) then 1441 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1442 write (*,*) ' VAR available=', varerr 1443 write (*,*) ' c2 < 0 after INTZHUNT' 1444 1445 elseif (ierr .eq. 46) then 1446 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1447 write (*,*) ' VAR available=', varerr 1448 write (*,*) ' p2 < 0 after INTZHUNT' 1449 1450 elseif (ierr .eq. 47) then 1451 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1452 write (*,*) ' VAR available=', varerr 1453 write (*,*) ' mr2 < 0 after INTZHUNT' 1454 1455 elseif (ierr .eq. 48) then 1456 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1457 write (*,*) ' VAR available=', varerr 1458 write (*,*) ' t2 < 0 after INTZHUNT' 1459 1460 elseif (ierr .eq. 49) then 1461 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1462 write (*,*) ' VAR available=', varerr 1463 write (*,*) ' st2 < 0 after INTZHUNT' 1464 1465 elseif (ierr .eq. 75) then 1466 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1467 write (*,*) ' VAR available=', varerr 1468 write (*,*) ' c1 < 0 after INTZHUNT' 1469 1470 elseif (ierr .eq. 76) then 1471 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1472 write (*,*) ' VAR available=', varerr 1473 write (*,*) ' p1 < 0 after INTZHUNT' 1474 1475 elseif (ierr .eq. 77) then 1476 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1477 write (*,*) ' VAR available=', varerr 1478 write (*,*) ' mr1 < 0 after INTZHUNT' 1479 1480 elseif (ierr .eq. 78) then 1481 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1482 write (*,*) ' VAR available=', varerr 1483 write (*,*) ' t1 < 0 after INTZHUNT' 1484 1485 elseif (ierr .eq. 79) then 1486 write (*,*) ' ERROR in MZTUD110. ierr=',ierr 1487 write (*,*) ' VAR available=', varerr 1488 write (*,*) ' st1 < 0 after INTZHUNT' 1489 1490 elseif (ierr .eq. 83) then 1491 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1492 write (*,*) ' VAR available=', varerr 1493 write (*,*) ' [CO2] < 0 at CurtisMatrix top.' 1494 1495 elseif (ierr .eq. 85) then 1496 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1497 write (*,*) ' VAR available=', varerr 1498 write (*,*) ' c1 < 0 after INTZHUNT' 1499 1500 elseif (ierr .eq. 86) then 1501 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1502 write (*,*) ' VAR available=', varerr 1503 write (*,*) ' p1 < 0 after INTZHUNT' 1504 1505 elseif (ierr .eq. 87) then 1506 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1507 write (*,*) ' VAR available=', varerr 1508 write (*,*) ' mr1 < 0 after INTZHUNT' 1509 1510 elseif (ierr .eq. 88) then 1511 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1512 write (*,*) ' VAR available=', varerr 1513 write (*,*) ' t1 < 0 after INTZHUNT' 1514 1515 elseif (ierr .eq. 89) then 1516 write (*,*) ' ERROR in MZTUD121. ierr=',ierr 1517 write (*,*) ' VAR available=', varerr 1518 write (*,*) ' st1 < 0 after INTZHUNT' 1519 1520 elseif (ierr .eq. 51) then 1521 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1522 write (*,*) ' VAR available=', varerr 1523 write (*,*) ' Ground transmittance vector VC < 0 ' 1524 1525 elseif (ierr .eq. 52) then 1526 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1527 write (*,*) ' VAR available=', varerr 1528 write (*,*) ' Atmospheric transmittance too large. ' 1529 1530 elseif (ierr .eq. 53) then 1531 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1532 write (*,*) ' VAR available=', varerr 1533 write (*,*) ' [CO2] < 0 at CurtisMatrix top.' 1534 1535 elseif (ierr .eq. 55) then 1536 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1537 write (*,*) ' VAR available=', varerr 1538 write (*,*) ' c2 < 0 after INTZHUNT' 1539 1540 elseif (ierr .eq. 56) then 1541 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1542 write (*,*) ' VAR available=', varerr 1543 write (*,*) ' p2 < 0 after INTZHUNT' 1544 1545 elseif (ierr .eq. 57) then 1546 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1547 write (*,*) ' VAR available=', varerr 1548 write (*,*) ' mr2 < 0 after INTZHUNT' 1549 1550 elseif (ierr .eq. 58) then 1551 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1552 write (*,*) ' VAR available=', varerr 1553 write (*,*) ' t2 < 0 after INTZHUNT' 1554 1555 elseif (ierr .eq. 59) then 1556 write (*,*) ' ERROR in MZTVC121. ierr=',ierr 1557 write (*,*) ' VAR available=', varerr 1558 write (*,*) ' st2 < 0 after INTZHUNT' 1559 1560 elseif (ierr .eq. 63) then 1561 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1562 write (*,*) ' VAR available=', varerr 1563 write (*,*) ' [CO2] < 0 at CurtisMatrix top.' 1564 1565 elseif (ierr .eq. 65) then 1566 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1567 write (*,*) ' VAR available=', varerr 1568 write (*,*) ' c2 < 0 after INTZHUNT' 1569 1570 elseif (ierr .eq. 66) then 1571 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1572 write (*,*) ' VAR available=', varerr 1573 write (*,*) ' p2 < 0 after INTZHUNT' 1574 1575 elseif (ierr .eq. 67) then 1576 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1577 write (*,*) ' VAR available=', varerr 1578 write (*,*) ' mr2 < 0 after INTZHUNT' 1579 1580 elseif (ierr .eq. 68) then 1581 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1582 write (*,*) ' VAR available=', varerr 1583 write (*,*) ' t2 < 0 after INTZHUNT' 1584 1585 elseif (ierr .eq. 69) then 1586 write (*,*) ' ERROR in MZESC121sub. ierr=',ierr 1587 write (*,*) ' VAR available=', varerr 1588 write (*,*) ' st2 < 0 after INTZHUNT' 1589 1590 elseif (ierr .eq. 21) then 1591 write (*,*) ' ERROR in CZA. ierr=',ierr 1592 write (*,*) ' VAR available=', varerr 1593 write (*,*) ' l11 < 0 ' 1594 1595 elseif (ierr .eq. 22) then 1596 write (*,*) ' ERROR in CZA. ierr=',ierr 1597 write (*,*) ' VAR available=', varerr 1598 write (*,*) ' l21 < 0 ' 1599 1600 elseif (ierr .eq. 23) then 1601 write (*,*) ' ERROR in CZA. ierr=',ierr 1602 write (*,*) ' VAR available=', varerr 1603 write (*,*) ' l31 < 0 ' 1604 1605 elseif (ierr .eq. 24) then 1606 write (*,*) ' ERROR in CZA. ierr=',ierr 1607 write (*,*) ' VAR available=', varerr 1608 write (*,*) ' l41 < 0 ' 1609 1610 elseif (ierr .eq. 25) then 1611 write (*,*) ' ERROR in CZA. ierr=',ierr 1612 write (*,*) ' VAR available=', varerr 1613 write (*,*) ' l12 < 0 ' 1614 1615 elseif (ierr .eq. 26) then 1616 write (*,*) ' ERROR in CZA. ierr=',ierr 1617 write (*,*) ' VAR available=', varerr 1618 write (*,*) ' Negative vibr.temp xvt11 < 0 ' 1619 1620 elseif (ierr .eq. 27) then 1621 write (*,*) ' ERROR in CZA. ierr=',ierr 1622 write (*,*) ' VAR available=', varerr 1623 write (*,*) ' Negative vibr.temp xvt21 < 0 ' 1624 1625 elseif (ierr .eq. 28) then 1626 write (*,*) ' ERROR in CZA. ierr=',ierr 1627 write (*,*) ' VAR available=', varerr 1628 write (*,*) ' Negative vibr.temp xvt31 < 0 ' 1629 1630 elseif (ierr .eq. 29) then 1631 write (*,*) ' ERROR in CZA. ierr=',ierr 1632 write (*,*) ' VAR available=', varerr 1633 write (*,*) ' Negative vibr.temp xvt41 < 0 ' 1634 1635 1636 endif 1637 1638 1639 stop ' Stopped in NLTE scheme due to severe error.' 1640 end -
trunk/LMDZ.MARS/libf/phymars/physiq.F
r1114 r1124 364 364 real ovmr_gcm(ngrid,nlayer) 365 365 real covmr_gcm(ngrid,nlayer) 366 366 integer ierr_nlte 367 real*8 varerr 367 368 368 369 c Variables for PBL … … 647 648 CALL nlte_tcool(ngrid,nlayer,zplay*9.869e-6, 648 649 $ pt,zzlay,co2vmr_gcm, n2vmr_gcm, covmr_gcm, 649 $ ovmr_gcm, zdtnlte ) 650 $ ovmr_gcm, zdtnlte,ierr_nlte,varerr ) 651 if(ierr_nlte.gt.0) then 652 write(*,*) 653 $ 'WARNING: nlte_tcool output with error message', 654 $ 'ierr_nlte=',ierr_nlte,'varerr=',varerr 655 write(*,*)'I will continue anyway' 656 endif 650 657 651 658 zdtnlte(1:ngrid,1:nlayer)= … … 876 883 877 884 zdtdif(ig,l)=zdhdif(ig,l)*zpopsk(ig,l) ! for diagnostic only 878 879 885 ENDDO 880 886 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
