Changeset 3018
- Timestamp:
- Jul 28, 2023, 6:11:44 AM (16 months ago)
- Location:
- trunk/LMDZ.MARS
- Files:
-
- 5 edited
- 2 moved
-
changelog.txt (modified) (1 diff)
-
libf/phymars/nlte_aux.F (modified) (63 diffs)
-
libf/phymars/nlte_calc.F (modified) (21 diffs)
-
libf/phymars/nlte_commons_h.F90 (moved) (moved from trunk/LMDZ.MARS/libf/phymars/nlte_commons.h) (1 diff)
-
libf/phymars/nlte_paramdef_h.F90 (moved) (moved from trunk/LMDZ.MARS/libf/phymars/nlte_paramdef.h) (1 diff)
-
libf/phymars/nlte_setup.F (modified) (7 diffs)
-
libf/phymars/nlte_tcool.F (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.MARS/changelog.txt
r3017 r3018 4146 4146 Optimization for adaptative subtimestep of water-ice clouds : should now be 4147 4147 much faster. + small cleanup 4148 4149 == 28/07/2023 == EM 4150 Further code cleanup with NLTE routines; converted nlte_paramdef.h to module 4151 nlte_paramdef_h.F90 and nlte_commons.h to module nlte_commons_h.F90 4152 (could not turn nlte_aux.F, nlte_setup.F and nlte_calc.F into modules due 4153 to circular dependencies; would require further code reorganization). -
trunk/LMDZ.MARS/libf/phymars/nlte_aux.F
r2606 r3018 1 ! MODULE nlte_aux_mod 2 3 ! IMPLICIT NONE 4 5 ! CONTAINS 1 6 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 7 ! Fast scheme for NLTE cooling rates at 15um by CO2 in a Martian GCM ! … … 98 103 function planckdp(tp,xnu) 99 104 c*********************************************************************** 100 101 implicit none 102 103 include 'nlte_paramdef.h' 105 use nlte_paramdef_h, only: gamma, ee 106 implicit none 104 107 105 108 real*8 planckdp … … 110 113 !erg cm-2.sr-1/cm-1. 111 114 112 c end 113 return 114 end 115 end function planckdp 115 116 116 117 c*********************************************************************** … … 118 119 119 120 c*********************************************************************** 120 121 implicit none 122 123 include 'nlte_paramdef.h' 124 include 'nlte_commons.h' 121 use nlte_paramdef_h, only: nl, nzy 122 use nlte_commons_h, only: zy, ty, zl 123 use nlte_commons_h, only: v626t1, v628t1, v636t1, v627t1 124 implicit none 125 125 126 126 c local variables … … 146 146 147 147 148 c end 149 return 150 end 148 end subroutine leetvt 151 149 152 150 … … 158 156 159 157 c **************************************************************** 160 161 implicit none 162 163 include 'nlte_paramdef.h' 164 include 'nlte_commons.h' 158 use nlte_commons_h, only: eqw, aa, cc, dd, nbox, ccbox, ddbox 159 implicit none 165 160 166 161 c local variables … … 179 174 end do 180 175 181 return 182 end 176 end subroutine initial 183 177 184 178 c ********************************************************************** … … 187 181 188 182 c ********************************************************************** 189 190 implicit none 191 192 include 'nlte_paramdef.h' 193 include 'nlte_commons.h' 183 use nlte_paramdef_h, only: nbox_max, nhist 184 use nlte_commons_h, only: nbox, thist, xls1, xld1 185 implicit none 194 186 195 187 c arguments … … 237 229 1 continue 238 230 239 return 240 end 231 end subroutine intershphunt 241 232 242 233 c ********************************************************************** … … 245 236 246 237 c ********************************************************************** 247 248 implicit none 249 250 include 'nlte_paramdef.h' 251 include 'nlte_commons.h' 238 use nlte_paramdef_h, only: nbox_max, nhist 239 use nlte_commons_h, only: nbox, thist, no, sk1 240 implicit none 252 241 253 242 c arguments … … 327 316 end do 328 317 329 330 return 331 end 318 end subroutine interstrhunt 332 319 333 320 c ********************************************************************** … … 338 325 c que esto represente una aceleracion real. 339 326 c ********************************************************************** 340 341 implicit none 342 include 'nlte_paramdef.h' 343 include 'nlte_commons.h' 327 use nlte_paramdef_h, only: nzy 328 use nlte_commons_h, only: zy, py, ty, mr 329 implicit none 344 330 345 331 c arguments … … 362 348 amr = dble( mr(k) + (mr(k+1)-mr(k)) * factor ) 363 349 364 365 return 366 end 350 end subroutine intzhunt 367 351 368 352 c ********************************************************************** … … 374 358 c que esto represente una aceleracion real. 375 359 c ********************************************************************** 376 377 implicit none 378 include 'nlte_paramdef.h' 379 include 'nlte_commons.h' 360 use nlte_paramdef_h, only: nzy_cts 361 use nlte_commons_h, only: zy_cts, py_cts, ty_cts, mr_cts 362 implicit none 380 363 381 364 c arguments … … 400 383 amr = dble( mr_cts(k) + (mr_cts(k+1)-mr_cts(k)) * factor ) 401 384 402 403 return 404 end 385 end subroutine intzhunt_cts 405 386 406 387 … … 410 391 411 392 c ********************************************************************** 412 413 implicit none 414 415 include 'nlte_paramdef.h' 393 implicit none 416 394 417 395 c arguments … … 481 459 we_clean = sqrt( wvoigt ) 482 460 483 484 return 485 end 461 end function we_clean 486 462 487 463 … … 491 467 492 468 c *********************************************************************** 493 494 implicit none 495 496 include 'nlte_paramdef.h' 497 include 'nlte_commons.h' 469 use nlte_paramdef_h, only: nzy, nl, ee, nu 470 use nlte_commons_h, only: nu11, v626t1, zy, zl, ty, elow 471 implicit none 498 472 499 473 c arguments … … 545 519 end do 546 520 547 548 return 549 end 521 end subroutine mztf_correccion 550 522 551 523 … … 555 527 556 528 c *********************************************************************** 557 558 implicit none 559 include 'nlte_paramdef.h' 529 use nlte_paramdef_h, only: nl 530 implicit none 560 531 561 532 c arguments … … 596 567 597 568 598 c end 599 return 600 end 569 end subroutine mzescape_normaliz 601 570 602 571 c *********************************************************************** … … 646 615 647 616 648 c end 649 return 650 end 617 end subroutine mzescape_normaliz_02 651 618 652 619 … … 658 625 659 626 c*********************************************************************** 660 661 implicit none 662 663 include 'nlte_paramdef.h' 664 include 'nlte_commons.h' 627 use nlte_paramdef_h, only: nl, nztabul 628 use nlte_commons_h, only: pl, taustar21, taustar31, taustar41 629 use nlte_commons_h, only: tstar21tab, tstar31tab, tstar41tab 630 use nlte_commons_h, only: lnpnbtab, vc210, vc310, vc410 631 use nlte_commons_h, only: vc210tab, vc310tab, vc410tab 632 implicit none 665 633 666 634 c local variables … … 687 655 688 656 c end 689 return 690 end 657 658 end subroutine interdp_ESCTVCISO 691 659 692 660 … … 757 725 goto 3 758 726 c 759 END 727 END SUBROUTINE hunt_cts 760 728 761 729 … … 817 785 goto 3 818 786 c 819 END 787 END SUBROUTINE huntdp 820 788 821 789 … … 883 851 goto 3 884 852 c 885 END 853 END SUBROUTINE hunt 886 854 887 855 … … 977 945 end if 978 946 1 continue 979 return 980 end 947 948 end subroutine interdp_limits 981 949 982 950 … … 1043 1011 1 continue 1044 1012 1045 return 1046 end 1013 end subroutine interhunt2veces 1047 1014 1048 1015 … … 1113 1080 1 continue 1114 1081 1115 return 1116 end 1082 end subroutine interhunt5veces 1117 1083 1118 1084 … … 1178 1144 1 continue 1179 1145 1180 return 1181 end 1146 end subroutine interhuntdp3veces 1182 1147 1183 1148 … … 1247 1212 1 continue 1248 1213 1249 return 1250 end 1214 end subroutine interhuntdp4veces 1251 1215 1252 1216 … … 1310 1274 1 continue 1311 1275 1312 return 1313 end 1276 end subroutine interhuntdp 1314 1277 1315 1278 … … 1374 1337 1 continue 1375 1338 1376 return 1377 end 1339 end subroutine interhunt 1378 1340 1379 1341 … … 1465 1427 1 continue 1466 1428 1467 return 1468 end 1429 end subroutine interhuntlimits2veces 1469 1430 1470 1431 … … 1567 1528 1 continue 1568 1529 1569 return 1570 end 1530 end subroutine interhuntlimits5veces 1571 1531 1572 1532 … … 1652 1612 1 continue 1653 1613 1654 return 1655 end 1614 end subroutine interhuntlimits 1656 1615 1657 1616 … … 1693 1652 b(i)=sum/a(i,i) 1694 1653 14 continue 1695 return 1696 end 1654 1655 end subroutine lubksb_dp 1697 1656 1698 1657 … … 1771 1730 19 continue 1772 1731 if(a(n,n).eq.0.0)a(n,n)=tiny 1773 return 1774 end 1732 1733 end subroutine ludcmp_dp 1775 1734 1776 1735 … … 1828 1787 enddo 1829 1788 1830 return 1831 end 1789 end subroutine LUdec 1832 1790 1833 1791 … … 1858 1816 a(k,n) = 0.0d0 1859 1817 end do 1860 return 1861 end 1818 1819 end subroutine unit 1862 1820 1863 1821 c *********************************************************************** … … 1885 1843 a(k,n) = 0.0d0 1886 1844 end do 1887 return 1888 end 1845 1846 end subroutine diago 1889 1847 1890 1848 c *********************************************************************** … … 1912 1870 a(k,n) = 0.0d0 1913 1871 end do 1914 return 1915 end 1872 1873 end subroutine invdiag 1916 1874 1917 1875 … … 1934 1892 a(k,n) = 0.0d0 1935 1893 end do 1936 return 1937 end 1894 1895 end subroutine samem 1938 1896 1939 1897 … … 1956 1914 a(1) = 0.0d0 1957 1915 a(n) = 0.0d0 1958 return 1959 end 1916 1917 end subroutine mulmv 1960 1918 1961 1919 … … 1986 1944 a(k,n) = 0.0d0 1987 1945 end do 1988 return 1989 end 1946 1947 end subroutine trucodiag 1990 1948 1991 1949 … … 2011 1969 v(1) = 0.d0 2012 1970 v(n) = 0.d0 2013 return 2014 end 1971 1972 end subroutine trucommvv 2015 1973 2016 1974 … … 2029 1987 v(1) = 0.0d0 2030 1988 v(n) = 0.0d0 2031 return 2032 end 1989 1990 end subroutine sypvmv 2033 1991 2034 1992 … … 2047 2005 a(1) = 0.0d0 2048 2006 a(n) = 0.0d0 2049 return 2050 end 2007 2008 end subroutine sumvv 2051 2009 2052 2010 … … 2063 2021 a(1) = 0.0d0 2064 2022 a(n) = 0.0d0 2065 return 2066 end 2023 2024 end subroutine sypvvv 2067 2025 2068 2026 … … 2103 2061 ! 2 continue 2104 2062 ! 1 continue 2105 return 2106 end 2063 2064 end subroutine zero4m 2107 2065 2108 2066 … … 2124 2082 ! 2 continue 2125 2083 ! 1 continue 2126 return 2127 end 2084 2085 end subroutine zero3m 2128 2086 2129 2087 … … 2143 2101 ! 2 continue 2144 2102 ! 1 continue 2145 return 2146 end 2103 end subroutine zero2m 2147 2104 2148 2105 … … 2178 2135 ! d(i) = 0.0d0 2179 2136 ! 1 continue 2180 return 2181 end 2137 2138 end subroutine zero4v 2182 2139 2183 2140 … … 2197 2154 ! c(i) = 0.0d0 2198 2155 ! 1 continue 2199 return 2200 end 2156 end subroutine zero3v 2201 2157 2202 2158 … … 2214 2170 ! b(i) = 0.0d0 2215 2171 ! 1 continue 2216 return 2217 end 2172 2173 end subroutine zero2v 2218 2174 2219 2175 c *********************************************************************** … … 2304 2260 end do 2305 2261 2306 return 2307 end 2262 end subroutine suaviza 2308 2263 2309 2264 … … 2321 2276 a(:,n)=0.d0 2322 2277 2323 return 2324 end 2278 end subroutine mulmmf90 2325 2279 2326 2280 … … 2338 2292 a(:,n)=0.d0 2339 2293 2340 return 2341 end 2294 end subroutine resmmf90 2342 2295 2343 2296 … … 2347 2300 2348 2301 c******************************************************************* 2349 2350 implicit none 2351 2352 include 'nlte_paramdef.h' 2353 include 'nlte_commons.h' 2354 2302 use nlte_commons_h, only: nbox, nbox_stored, mm_stored, thist 2303 use nlte_commons_h, only: thist_stored, no, no_stored, sk1 2304 use nlte_commons_h, only: sk1_stored, xls1, xls1_stored, xld1 2305 use nlte_commons_h, only: xld1_stored 2306 implicit none 2355 2307 2356 2308 c arguments … … 2373 2325 enddo 2374 2326 2375 2376 return 2377 end 2327 end subroutine gethist_03 2378 2328 2379 2329 … … 2385 2335 2386 2336 c ******************************************************************* 2387 2388 implicit none 2389 2390 include 'nlte_paramdef.h' 2391 include 'nlte_commons.h' 2392 2337 use nlte_paramdef_h, only: nbox_max 2338 use nlte_commons_h, only: mm_stored, nbox_stored, nbox_stored 2339 use nlte_commons_h, only: thist_stored, no_stored, sk1_stored 2340 use nlte_commons_h, only: xls1_stored, xld1_stored, hisfile 2341 implicit none 2393 2342 2394 2343 c arguments … … 2443 2392 call bcast(xld1_stored) 2444 2393 2445 return 2446 end 2394 end subroutine rhist_03 2395 2396 ! END MODULE nlte_aux_mod -
trunk/LMDZ.MARS/libf/phymars/nlte_calc.F
r3012 r3018 1 ! MODULE nlte_calc_mod 2 3 ! USE nlte_aux_mod 4 5 ! IMPLICIT NONE 6 7 ! CONTAINS 1 8 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 2 9 ! Fast scheme for NLTE cooling rates at 15um by CO2 in a Martian GCM ! … … 29 36 c*********************************************************************** 30 37 use nlte_tcool_mod, only: errors 38 use nlte_paramdef_h, only: nl_cts, nzy_cts, nbox_max, nhist 39 use nlte_paramdef_h, only: ee, imr 40 use nlte_commons_h, only: elow, deltanu, eqw, aa, cc, dd 41 use nlte_commons_h, only: deltaz_cts, taustar11_cts, ibcode1 42 use nlte_commons_h, only: pp, ta, w, ka, alsa, alda, kr, nbox 43 use nlte_commons_h, only: ty_cts, py_cts, nty_cts, co2y_cts 44 use nlte_commons_h, only: ddbox, ccbox, mr_cts, zl_cts, no 31 45 implicit none 32 33 include 'nlte_paramdef.h'34 include 'nlte_commons.h'35 46 36 47 c arguments … … 214 225 call mzescape_normaliz_02 ( taustar11_cts, nl_cts_real, 2 ) 215 226 216 c end 217 return 218 end 227 end subroutine MZESC110 219 228 220 229 … … 224 233 subroutine MZTUD110( ierr, varerr ) 225 234 c*********************************************************************** 226 235 use nlte_paramdef_h, only: nl, nzy, nbox_max, nhist, imr, ee 236 use nlte_commons_h, only: ibcode1, deltanu, deltaz 237 use nlte_commons_h, only: eqw, aa, cc, dd, nbox, pp, ta, w 238 use nlte_commons_h, only: ka, alsa ,alda , kr 239 use nlte_commons_h, only: ddbox, ccbox, mr 240 use nlte_commons_h, only: v626t1, zy, zl, co2y, nty, elow, no 241 227 242 implicit none 228 229 include 'nlte_paramdef.h'230 include 'nlte_commons.h'231 232 243 233 244 c arguments … … 606 617 call MZCUD110 ( tauinf,tau ) 607 618 608 c end 609 return 610 end 619 end subroutine MZTUD110 611 620 612 621 … … 618 627 619 628 c*********************************************************************** 620 629 use nlte_paramdef_h, only: nl 630 use nlte_commons_h, only: deltanu, deltaz, c110, vc110 621 631 implicit none 622 623 include 'nlte_paramdef.h'624 include 'nlte_commons.h'625 632 626 633 c arguments … … 699 706 end do 700 707 701 c end 702 return 703 end 708 end subroutine MZCUD110 704 709 705 710 … … 712 717 c*********************************************************************** 713 718 use nlte_tcool_mod, only: errors 719 use nlte_paramdef_h, only: nl, nu, nu12_0200, nu12_1000, ee 720 use nlte_commons_h, only: t, c121, vc121 714 721 implicit none 715 722 716 ! common variables & constants 717 718 include 'nlte_paramdef.h' 719 include 'nlte_commons.h' 720 721 ! local variables 723 ! local variables 722 724 723 725 real*8 cax1(nl,nl) … … 779 781 11 continue 780 782 781 return 782 end 783 end subroutine MZMC121 783 784 784 785 … … 788 789 subroutine MZTUD121 ( cf,vc, ib, ierr, varerr ) 789 790 c*********************************************************************** 790 791 use nlte_paramdef_h, only: nl, nzy, nbox_max, nhist, imr, ee 792 use nlte_commons_h, only: ibcode1, deltanu, deltaz, zl, zy 793 use nlte_commons_h, only: eqw, aa, cc, dd, ddbox, ccbox, nbox 794 use nlte_commons_h, only: ka, alsa, alda, kr, pp, ta, w 795 use nlte_commons_h, only: v626t1, elow, co2y, mr, nty, no 791 796 implicit none 792 793 include 'nlte_paramdef.h'794 include 'nlte_commons.h'795 796 797 797 798 c arguments … … 1144 1145 1145 1146 1146 c end 1147 return 1148 end 1147 end subroutine MZTUD121 1149 1148 1150 1149 … … 1157 1156 1158 1157 c*********************************************************************** 1159 1158 use nlte_paramdef_h, only: nl 1159 use nlte_commons_h, only: deltanu, deltaz 1160 1160 implicit none 1161 1162 include 'nlte_paramdef.h'1163 include 'nlte_commons.h'1164 1165 1161 1166 1162 c arguments … … 1246 1242 end do 1247 1243 1248 1249 c end 1250 return 1251 end 1244 end subroutine MZCUD121 1252 1245 1253 1246 … … 1259 1252 c*********************************************************************** 1260 1253 use nlte_tcool_mod, only: errors 1254 use nlte_paramdef_h, only: nl, nu, nu12_0200, nu12_1000 1255 use nlte_commons_h, only: taustar12 1261 1256 implicit none 1262 1263 include 'nlte_paramdef.h'1264 include 'nlte_commons.h'1265 1266 1257 1267 1258 c local variables … … 1300 1291 call mzescape_normaliz ( taustar12, 2 ) 1301 1292 1302 c end 1303 return 1304 end 1293 1294 end subroutine MZESC121 1305 1295 1306 1296 … … 1312 1302 1313 1303 c*********************************************************************** 1314 1304 use nlte_paramdef_h, only: nhist, nl, nzy, imr, ee 1305 use nlte_commons_h, only: ibcode1, deltanu, deltaz 1306 use nlte_commons_h, only: eqw, aa, cc, dd, ddbox, ccbox 1307 use nlte_commons_h, only: v626t1, pp, ta, w, nbox 1308 use nlte_commons_h, only: ka, alsa, alda, kr 1309 use nlte_commons_h, only: zy, zl, co2y, nty, mr, elow, no 1315 1310 implicit none 1316 1317 include 'nlte_paramdef.h'1318 include 'nlte_commons.h'1319 1320 1311 1321 1312 c arguments … … 1505 1496 1506 1497 1507 1508 c end 1509 return 1510 end 1498 end subroutine MZESC121sub 1511 1499 1512 1500 … … 1518 1506 1519 1507 c*********************************************************************** 1520 1508 use nlte_paramdef_h, only: nl, nu, nu12_0200, nu12_1000 1509 use nlte_commons_h, only: vc121 1521 1510 implicit none 1522 1523 !!!!!!!!!!!!!!!!!!!!!!!1524 ! common variables & constants1525 1526 include 'nlte_paramdef.h'1527 include 'nlte_commons.h'1528 1529 1511 1530 1512 integer ierr … … 1566 1548 11 continue 1567 1549 1568 1569 return 1570 end 1550 end subroutine MZTVC121 1571 1551 1572 1552 … … 1578 1558 1579 1559 c*********************************************************************** 1580 1560 use nlte_paramdef_h, only: nhist, nl, nzy, imr, ee 1561 use nlte_commons_h, only: ibcode1, deltanu, deltaz 1562 use nlte_commons_h, only: eqw, aa, cc, dd, ddbox, ccbox 1563 use nlte_commons_h, only: v626t1, pp, ta, w, nbox 1564 use nlte_commons_h, only: ka, alsa, alda, kr 1565 use nlte_commons_h, only: zy, zl, co2y, nty, mr, elow, no 1581 1566 implicit none 1582 1583 include 'nlte_paramdef.h'1584 include 'nlte_commons.h'1585 1586 1567 1587 1568 c arguments … … 1799 1780 endif 1800 1781 1801 c end 1802 return 1803 end 1804 1805 1806 1807 1808 1809 1810 1811 1812 1782 end subroutine MZTVC121sub 1783 1784 1785 ! END MODULE nlte_calc_mod 1786 1787 1788 1789 1790 1791 -
trunk/LMDZ.MARS/libf/phymars/nlte_commons_h.F90
r3017 r3018 1 c**************************************************************************** 2 c 3 c Merging of different common blocks used in the new NLTE 15um param 4 c 5 c jan 2012 fgg+malv 6 c**************************************************************************** 7 c *** Old datitos.cmn *** 8 c 9 common /spectralv11/ elow, deltanu 10 ! $OMP THREADPRIVATE(/spectralv11/)11 real elow(nisot,nb), deltanu(nisot,nb) 12 13 14 common/nu_levs_bands_v11/ nu11, nu12, nu121, 15 @ nu21, nu31, nu41 16 ! $OMP THREADPRIVATE(/nu_levs_bands_v11/)17 real*8 nu11, nu12, nu121 18 real*8 nu21 19 real*8 nu31 20 real*8 nu41 21 22 23 common /aeinstein1v11/ a1_010_000, a1_020_010 24 !$OMP THREADPRIVATE(/aeinstein1v11/) 25 common /aeinstein2v11/ a2_010_000 26 !$OMP THREADPRIVATE( /aeinstein2v11/)27 common /aeinstein3v11/ a3_010_000 28 !$OMP THREADPRIVATE(/aeinstein3v11/) 29 common /aeinstein4v11/ a4_010_000 30 ! $OMP THREADPRIVATE(/aeinstein4v11/)31 32 real*8 a1_010_000, a1_020_010 33 real*8 a2_010_000 34 real*8 a3_010_00035 real*8 a4_010_000 36 37 38 c *** Old tabulation.cmn *** 39 40 common/input_tab_v11/ lnpnbtab, 41 @ tstar11tab, tstar21tab, tstar31tab, tstar41tab, 42 @ vc210tab, vc310tab, vc410tab 43 ! $OMP THREADPRIVATE(/input_tab_v11/)44 45 real*8 lnpnbtab(nztabul) 46 real*8 vc210tab(nztabul), vc310tab(nztabul), vc410tab(nztabul)47 real*8 tstar11tab(nztabul), tstar21tab(nztabul), 48 @ tstar31tab(nztabul), tstar41tab(nztabul)49 50 51 c *** Old nlte_results.cmn *** 52 53 common/input_avilable_from/ input_cza 54 ! $OMP THREADPRIVATE(/input_avilable_from/)55 integer input_cza 56 57 c temperatura vibracional de entrada: 58 common/temp626/ v626t1 59 !$OMP THREADPRIVATE(/temp626/) 60 common/temp628/ v628t1 61 ! $OMP THREADPRIVATE(/temp628/)62 common/temp636/ v636t163 ! $OMP THREADPRIVATE(/temp636/)64 65 !$OMP THREADPRIVATE(/temp627/)66 real*8 v626t1(nl)67 real*8 v628t1(nl)68 real*8 v636t1(nl)69 real*8 v627t1(nl)70 71 coutput de cza.for72 common /tv15um/vt11, vt12, vt21, vt31, vt4173 !$OMP THREADPRIVATE(/tv15um/)74 real*8 vt11(nl), vt12(nl), vt21(nl), vt31(nl), vt41(nl)75 76 common /hr15um/hr110,hr210,hr310,hr410,hr12177 !$OMP THREADPRIVATE(/hr15um/)78 real*8 hr110(nl),hr121(nl), 79 @ hr210(nl),hr310(nl),hr410(nl)80 81 common/sf15um/ el11,el12, el21, el31, el4182 !$OMP THREADPRIVATE(/sf15um/)83 real*8 el11(nl), el12(nl)84 real*8 el21(nl)85 real*8 el31(nl)86 real*8 el41(nl)87 88 common/sl15um/ sl110,sl121, sl210,sl310,sl41089 !$OMP THREADPRIVATE(/sl15um/)90 real*8 sl110(nl), sl121(nl)91 real*8 sl210(nl)92 real*8 sl310(nl)93 real*8 sl410(nl)94 95 96 c*** Old matrices.cmn ***97 98 99 c curtis matrix de cza: 100 common/curtis_matrixes_15um/ c110,c121, c210,101 @ c310,c410, 102 @ vc110,vc121,vc210,vc310,vc410103 !$OMP THREADPRIVATE(/curtis_matrixes_15um/)104 real*8 c110(nl,nl), c121(nl,nl)105 real*8 c210(nl,nl)106 real*8 c310(nl,nl)107 real*8 c410(nl,nl)108 real*8 vc110(nl), vc121(nl)109 real*8 vc210(nl), vc310(nl), vc410(nl)110 1 MODULE nlte_commons_h 2 3 USE nlte_paramdef_h, ONLY: nb, nisot, nztabul, nl, nl_cts, nzy, nzy_cts 4 USE nlte_paramdef_h, ONLY: nbox_max, nhist 5 6 IMPLICIT NONE 7 8 !**************************************************************************** 9 ! 10 ! Merging of different common blocks used in the new NLTE 15um param 11 ! 12 ! jan 2012 fgg+malv 13 !**************************************************************************** 14 ! *** Old datitos.cmn *** 15 ! 16 ! common /spectralv11/ elow, deltanu 17 real,save :: elow(nisot,nb), deltanu(nisot,nb) 18 !$OMP THREADPRIVATE(elow,deltanu) 19 20 ! common/nu_levs_bands_v11/ nu11, nu12, nu121, 21 ! @ nu21, nu31, nu41 22 real*8,save :: nu11, nu12, nu121 23 real*8,save :: nu21 24 real*8,save :: nu31 25 real*8,save :: nu41 26 !$OMP THREADPRIVATE(nu11,nu12,nu121,nu21,nu31,nu41) 27 28 29 ! common /aeinstein1v11/ a1_010_000, a1_020_010 30 ! common /aeinstein2v11/ a2_010_000 31 ! common /aeinstein3v11/ a3_010_000 32 ! common /aeinstein4v11/ a4_010_000 33 real*8,save :: a1_010_000, a1_020_010 34 real*8,save :: a2_010_000 35 real*8,save :: a3_010_000 36 real*8,save :: a4_010_000 37 !$OMP THREADPRIVATE(a1_010_000,a1_020_010,a2_010_000) 38 !$OMP THREADPRIVATE(a3_010_000,a4_010_000) 39 40 ! *** Old tabulation.cmn *** 41 42 ! common/input_tab_v11/ lnpnbtab, 43 ! @ tstar11tab, tstar21tab, tstar31tab, tstar41tab, 44 ! @ vc210tab, vc310tab, vc410tab 45 46 real*8,save :: lnpnbtab(nztabul) 47 real*8,save :: vc210tab(nztabul), vc310tab(nztabul), vc410tab(nztabul) 48 real*8,save :: tstar11tab(nztabul), tstar21tab(nztabul) 49 real*8,save :: tstar31tab(nztabul), tstar41tab(nztabul) 50 !$OMP THREADPRIVATE(lnpnbtab) 51 !$OMP THREADPRIVATE(vc210tab,vc310tab,vc410tab) 52 !$OMP THREADPRIVATE(tstar11tab,tstar21tab,tstar31tab,tstar41tab) 53 54 ! *** Old nlte_results.cmn *** 55 56 ! common/input_avilable_from/ input_cza 57 integer,save :: input_cza 58 !$OMP THREADPRIVATE(input_cza) 59 60 ! temperatura vibracional de entrada: 61 ! common/temp626/ v626t1 62 ! common/temp628/ v628t1 63 ! common/temp636/ v636t1 64 ! common/temp627/ v627t1 65 real*8,save :: v626t1(nl) 66 real*8,save :: v628t1(nl) 67 real*8,save :: v636t1(nl) 68 real*8,save :: v627t1(nl) 69 !$OMP THREADPRIVATE(v626t1,v628t1,v636t1,v627t1) 70 71 ! output de cza.for 72 ! common /tv15um/ vt11, vt12, vt21, vt31, vt41 73 real*8,save :: vt11(nl), vt12(nl), vt21(nl), vt31(nl), vt41(nl) 74 !$OMP THREADPRIVATE(vt11,vt12,vt21,vt31,vt41) 75 76 ! common /hr15um/ hr110,hr210,hr310,hr410,hr121 77 real*8,save :: hr110(nl),hr121(nl) 78 real*8,save :: hr210(nl),hr310(nl),hr410(nl) 79 !$OMP THREADPRIVATE(hr110,hr121,hr210,hr310,hr410) 80 81 ! common/sf15um/ el11,el12, el21, el31, el41 82 real*8,save :: el11(nl), el12(nl) 83 real*8,save :: el21(nl) 84 real*8,save :: el31(nl) 85 real*8,save :: el41(nl) 86 !$OMP THREADPRIVATE(el11,el12,el21,el31,el41) 87 88 ! common/sl15um/ sl110,sl121, sl210,sl310,sl410 89 real*8,save :: sl110(nl), sl121(nl) 90 real*8,save :: sl210(nl) 91 real*8,save :: sl310(nl) 92 real*8,save :: sl410(nl) 93 !$OMP THREADPRIVATE(sl110,sl121,sl210,sl310,sl410) 94 95 96 ! *** Old matrices.cmn *** 97 98 ! curtis matrix de cza: 99 ! common/curtis_matrixes_15um/ c110,c121, c210, 100 ! @ c310,c410, 101 ! @ vc110,vc121,vc210,vc310,vc410 102 real*8,save :: c110(nl,nl), c121(nl,nl) 103 real*8,save :: c210(nl,nl) 104 real*8,save :: c310(nl,nl) 105 real*8,save :: c410(nl,nl) 106 real*8,save :: vc110(nl), vc121(nl) 107 real*8,save :: vc210(nl), vc310(nl), vc410(nl) 108 !$OMP THREADPRIVATE(c110,c121,c210,c310,c410) 109 !$OMP THREADPRIVATE(vc110,vc121,vc210,vc310,vc410) 110 111 111 ! for the cool-to-space formulation: 112 112 ! 113 common/taustar_15um/ taustar11, taustar21, taustar31, 114 @ taustar41, taustar12, taustar11_cts 115 !$OMP THREADPRIVATE(/taustar_15um/) 116 real*8 taustar11(nl), taustar21(nl), taustar31(nl) 117 real*8 taustar41(nl), taustar12(nl) 118 real*8 taustar11_cts(nl_cts) 119 120 121 c *** Old atmref.cmn *** 122 123 124 c NLTE Subgrid 125 c 126 common /atm_nl/ zl, t, pl, nt, co2, n2, co, o3p, 127 @ co2vmr, n2vmr, covmr, o3pvmr, 128 @ hrkday_factor 129 !$OMP THREADPRIVATE(/atm_nl/) 130 131 real zl(nl), t(nl), pl(nl), nt(nl), 132 @ co2(nl), n2(nl), co(nl), o3p(nl), 133 @ co2vmr(nl), n2vmr(nl), covmr(nl), o3pvmr(nl), 134 @ hrkday_factor(nl) 135 136 137 c Subgrid Transmittances 138 c 139 common /atm_ny/ zy, ty, py, nty, co2y 140 !$OMP THREADPRIVATE(/atm_ny/) 141 real zy(nzy), ty(nzy), py(nzy), nty(nzy), co2y(nzy) 142 143 c Grids and indexes 144 common/deltazetas/ deltaz, deltazy, deltaz_cts, deltazy_cts, 145 @ jlowerboundary, jtopboundary, jtopCTS 146 !$OMP THREADPRIVATE(/deltazetas/) 147 real deltaz, deltazy, deltaz_cts, deltazy_cts 148 integer jlowerboundary, jtopboundary, jtopCTS 149 150 151 c NLTE-CTS Subgrid 152 c 153 common /atm_nl_cts/ zl_cts, t_cts, pl_cts, nt_cts, 154 @ co2_cts, n2_cts, co_cts, o3p_cts, 155 @ co2vmr_cts, n2vmr_cts, covmr_cts, o3pvmr_cts, 156 @ hrkday_factor_cts,mmean_cts,cpnew_cts 157 !$OMP THREADPRIVATE(/atm_nl_cts/) 158 159 real zl_cts(nl_cts), t_cts(nl_cts), pl_cts(nl_cts), 160 @ nt_cts(nl_cts), co2_cts(nl_cts), 161 @ n2_cts(nl_cts), co_cts(nl_cts), 162 @ o3p_cts(nl_cts), co2vmr_cts(nl_cts), n2vmr_cts(nl_cts), 163 @ covmr_cts(nl_cts), o3pvmr_cts(nl_cts), 164 @ hrkday_factor_cts(nl_cts),mmean_cts(nl_cts), 165 @ cpnew_cts(nl_cts) 166 167 168 c CTS Subgrid Transmittances 169 c 170 common /atm_ny_cts/ zy_cts, ty_cts, py_cts, nty_cts, co2y_cts 171 !$OMP THREADPRIVATE(/atm_ny_cts/) 172 real zy_cts(nzy_cts), ty_cts(nzy_cts), py_cts(nzy_cts), 173 @ nty_cts(nzy_cts), co2y_cts(nzy_cts) 174 175 176 c *** Old rates.cmn *** 177 178 common/rates_vt/ 179 @ k19ba(4),k19bb(4),k19bc(4), k19bap(4),k19bbp(4),k19bcp(4), 180 @ k19ca(4),k19cb(4),k19cc(4), k19cap(4),k19cbp(4),k19ccp(4), 181 @ k20b(4),k20c(4), k20bp(4),k20cp(4) 182 !$OMP THREADPRIVATE(/rates_vt/) 183 184 real*8 k19ba,k19bb,k19bc, k19bap,k19bbp,k19bcp 185 real*8 k19ca,k19cb,k19cc, k19cap,k19cbp,k19ccp 186 real*8 k20b,k20c, k20bp,k20cp 187 188 common/rates_vv/ 189 @ k21b(4),k21c(4), k21bp(4),k21cp(4), 190 @ k33c, k33cp(2:4) 191 !$OMP THREADPRIVATE(/rates_vv/) 192 193 real*8 k21b,k21c, k21bp,k21cp 194 real*8 k33c, k33cp 195 196 common/rates_last/ k23k21c, k24k21c, k34k21c, 197 @ k23k21cp, k24k21cp, k34k21cp 198 !$OMP THREADPRIVATE(/rates_last/) 199 200 real*8 k23k21c,k24k21c,k34k21c, k23k21cp,k24k21cp,k34k21cp 201 202 203 204 c *** Old curtis.cmn *** 205 206 common /ini_file/ ibcode1 207 !$OMP THREADPRIVATE(/ini_file/) 208 character ibcode1*1 209 210 common/block1/ alsa,alda,ka,kr 211 !$OMP THREADPRIVATE(/block1/) 212 real*8 ka(nbox_max),alsa(nbox_max),alda(nbox_max) 213 integer kr 214 215 common/block2/ hisfile 216 !$OMP THREADPRIVATE(/block2/) 217 character hisfile*75 218 219 common/block3/ pp,ta,w 220 !$OMP THREADPRIVATE(/block3/) 221 real*8 pp,ta(nbox_max),w 222 223 common/block4/ no,sk1,xls1,xld1,thist,nbox 224 !$OMP THREADPRIVATE(/block4/) 225 real*8 sk1(nhist,nbox_max) 226 real*8 xls1(nhist,nbox_max) 227 real*8 xld1(nhist,nbox_max) 228 real*8 thist(nhist) 229 real*8 no(nbox_max) 230 integer nbox 231 232 common/block5/eqw, aa, cc, dd, ddbox, ccbox, mr, mr_cts 233 !$OMP THREADPRIVATE(/block5/) 234 real*8 eqw, aa, cc, dd 235 real*8 ddbox(nbox_max), ccbox(nbox_max) 236 real*8 mr(nzy), mr_cts(nzy_cts) 237 238 common/blockstore/no_stored, sk1_stored, xls1_stored, 239 & xld1_stored, thist_stored, nbox_stored, 240 & mm_stored 241 !$OMP THREADPRIVATE(/blockstore/) 242 real*8 sk1_stored(nb,nhist,nbox_max) 243 real*8 xls1_stored(nb,nhist,nbox_max) 244 real*8 xld1_stored(nb,nhist,nbox_max) 245 real*8 thist_stored(nb,nhist) 246 real*8 no_stored(nb,nbox_max) 247 integer nbox_stored(nb), mm_stored(nb) 248 249 c***************************************************** 250 251 252 c************************************************************* 253 254 255 256 257 c**************************************************************************** 258 259 260 113 ! common/taustar_15um/ taustar11, taustar21, taustar31, 114 ! @ taustar41, taustar12, taustar11_cts 115 real*8,save :: taustar11(nl), taustar21(nl), taustar31(nl) 116 real*8,save :: taustar41(nl), taustar12(nl) 117 real*8,save :: taustar11_cts(nl_cts) 118 !$OMP THREADPRIVATE(taustar11,taustar21,taustar31) 119 !$OMP THREADPRIVATE(taustar41,taustar12,taustar11_cts) 120 121 122 ! *** Old atmref.cmn *** 123 124 ! NLTE Subgrid 125 ! common /atm_nl/ zl, t, pl, nt, co2, n2, co, o3p, 126 ! @ co2vmr, n2vmr, covmr, o3pvmr, 127 ! @ hrkday_factor 128 real,save :: zl(nl), t(nl), pl(nl), nt(nl) 129 real,save :: co2(nl), n2(nl), co(nl), o3p(nl) 130 real,save :: co2vmr(nl), n2vmr(nl), covmr(nl), o3pvmr(nl) 131 real,save :: hrkday_factor(nl) 132 !$OMP THREADPRIVATE(zl,t,pl,nt,co2,n2,co,o3p) 133 !$OMP THREADPRIVATE(co2vmr,n2vmr,covmr,o3pvmr,hrkday_factor) 134 135 136 ! Subgrid Transmittances 137 ! common /atm_ny/ zy, ty, py, nty, co2y 138 real,save :: zy(nzy), ty(nzy), py(nzy), nty(nzy), co2y(nzy) 139 !$OMP THREADPRIVATE(zy,ty,py,nty,co2y) 140 141 ! Grids and indexes 142 ! common/deltazetas/ deltaz, deltazy, deltaz_cts, deltazy_cts, 143 ! @ jlowerboundary, jtopboundary, jtopCTS 144 real,save :: deltaz, deltazy, deltaz_cts, deltazy_cts 145 integer,save :: jlowerboundary, jtopboundary, jtopCTS 146 !$OMP THREADPRIVATE(deltaz,deltazy,deltaz_cts,deltazy_cts) 147 !$OMP THREADPRIVATE(jlowerboundary,jtopboundary,jtopCTS) 148 149 ! NLTE-CTS Subgrid 150 ! common /atm_nl_cts/ zl_cts, t_cts, pl_cts, nt_cts, 151 ! @ co2_cts, n2_cts, co_cts, o3p_cts, 152 ! @ co2vmr_cts, n2vmr_cts, covmr_cts, o3pvmr_cts, 153 ! @ hrkday_factor_cts,mmean_cts,cpnew_cts 154 real,save :: zl_cts(nl_cts), t_cts(nl_cts), pl_cts(nl_cts) 155 real,save :: nt_cts(nl_cts), co2_cts(nl_cts) 156 real,save :: n2_cts(nl_cts), co_cts(nl_cts) 157 real,save :: o3p_cts(nl_cts), co2vmr_cts(nl_cts), n2vmr_cts(nl_cts) 158 real,save :: covmr_cts(nl_cts), o3pvmr_cts(nl_cts) 159 real,save :: hrkday_factor_cts(nl_cts),mmean_cts(nl_cts) 160 real,save :: cpnew_cts(nl_cts) 161 !$OMP THREADPRIVATE(zl_cts,t_cts,pl_cts,nt_cts,co2_cts,n2_cts,co_cts) 162 !$OMP THREADPRIVATE(o3p_cts,co2vmr_cts,n2vmr_cts,covmr_cts,o3pvmr_cts) 163 !$OMP THREADPRIVATE(hrkday_factor_cts,mmean_cts,cpnew_cts) 164 165 ! CTS Subgrid Transmittances 166 ! common /atm_ny_cts/ zy_cts, ty_cts, py_cts, nty_cts, co2y_cts 167 real,save :: zy_cts(nzy_cts), ty_cts(nzy_cts), py_cts(nzy_cts) 168 real,save :: nty_cts(nzy_cts), co2y_cts(nzy_cts) 169 !$OMP THREADPRIVATE(zy_cts,ty_cts,py_cts,nty_cts,co2y_cts) 170 171 172 ! *** Old rates.cmn *** 173 ! common/rates_vt/ 174 ! @ k19ba(4),k19bb(4),k19bc(4), k19bap(4),k19bbp(4),k19bcp(4), 175 ! @ k19ca(4),k19cb(4),k19cc(4), k19cap(4),k19cbp(4),k19ccp(4), 176 ! @ k20b(4),k20c(4), k20bp(4),k20cp(4) 177 real*8,save :: k19ba(4),k19bb(4),k19bc(4), k19bap(4),k19bbp(4),k19bcp(4) 178 real*8,save :: k19ca(4),k19cb(4),k19cc(4), k19cap(4),k19cbp(4),k19ccp(4) 179 real*8,save :: k20b(4),k20c(4), k20bp(4),k20cp(4) 180 !$OMP THREADPRIVATE(k19ba,k19bb,k19bc,k19bap,k19bbp,k19bcp) 181 !$OMP THREADPRIVATE(k19ca,k19cb,k19cc,k19cap,k19cbp,k19ccp) 182 !$OMP THREADPRIVATE(k20b,k20c,k20bp,k20cp) 183 184 ! common/rates_vv/ 185 ! @ k21b(4),k21c(4), k21bp(4),k21cp(4), 186 ! @ k33c, k33cp(2:4) 187 real*8,save :: k21b(4),k21c(4), k21bp(4),k21cp(4) 188 real*8,save :: k33c, k33cp(2:4) 189 !$OMP THREADPRIVATE(k21b,k21c,k21bp,k21cp,k33c,k33cp) 190 191 ! common/rates_last/ k23k21c, k24k21c, k34k21c, 192 ! @ k23k21cp, k24k21cp, k34k21cp 193 real*8,save :: k23k21c,k24k21c,k34k21c, k23k21cp,k24k21cp,k34k21cp 194 !$OMP THREADPRIVATE(k23k21c,k24k21c,k34k21c,k23k21cp,k24k21cp,k34k21cp) 195 196 197 ! *** Old curtis.cmn *** 198 199 ! common /ini_file/ ibcode1 200 character,save :: ibcode1*1 201 !$OMP THREADPRIVATE(ibcode1) 202 203 ! common/block1/ alsa,alda,ka,kr 204 real*8,save :: ka(nbox_max),alsa(nbox_max),alda(nbox_max) 205 integer,save :: kr 206 !$OMP THREADPRIVATE(ka,alsa,alda,kr) 207 208 ! common/block2/ hisfile 209 character,save :: hisfile*75 210 !$OMP THREADPRIVATE(hisfile) 211 212 ! common/block3/ pp,ta,w 213 real*8,save :: pp,ta(nbox_max),w 214 !$OMP THREADPRIVATE(pp,ta,w) 215 216 ! common/block4/ no,sk1,xls1,xld1,thist,nbox 217 real*8,save :: sk1(nhist,nbox_max) 218 real*8,save :: xls1(nhist,nbox_max) 219 real*8,save :: xld1(nhist,nbox_max) 220 real*8,save :: thist(nhist) 221 real*8,save :: no(nbox_max) 222 integer,save :: nbox 223 !$OMP THREADPRIVATE(sk1,xls1,xld1,thist,no,nbox) 224 225 ! common/block5/eqw, aa, cc, dd, ddbox, ccbox, mr, mr_cts 226 real*8,save :: eqw, aa, cc, dd 227 real*8,save :: ddbox(nbox_max), ccbox(nbox_max) 228 real*8,save :: mr(nzy), mr_cts(nzy_cts) 229 !$OMP THREADPRIVATE(eqw,aa,cc,dd,ddbox,ccbox,mr,mr_cts) 230 231 ! common/blockstore/no_stored, sk1_stored, xls1_stored, 232 ! & xld1_stored, thist_stored, nbox_stored, 233 ! & mm_stored 234 real*8,save :: sk1_stored(nb,nhist,nbox_max) 235 real*8,save :: xls1_stored(nb,nhist,nbox_max) 236 real*8,save :: xld1_stored(nb,nhist,nbox_max) 237 real*8,save :: thist_stored(nb,nhist) 238 real*8,save :: no_stored(nb,nbox_max) 239 integer,save :: nbox_stored(nb), mm_stored(nb) 240 !$OMP THREADPRIVATE(sk1_stored,xls1_stored,xld1_stored) 241 !$OMP THREADPRIVATE(thist_stored,no_stored,nbox_stored,mm_stored) 242 243 !**************************************************************************** 244 245 END MODULE nlte_commons_h 246 247 -
trunk/LMDZ.MARS/libf/phymars/nlte_paramdef_h.F90
r3017 r3018 1 c**************************************************************************** 2 c 3 c Merging of different parameters definitions for new NLTE 15um param 4 c 5 c jul 2012 fgg+malv 6 c**************************************************************************** 7 c *** Old mz1d.par *** 1 MODULE nlte_paramdef_h 2 3 IMPLICIT NONE 4 5 !**************************************************************************** 6 ! 7 ! Merging of different parameters definitions for new NLTE 15um param 8 ! 9 ! jul 2012 fgg+malv 10 !**************************************************************************** 11 ! *** Old mz1d.par *** 8 12 ! Grids parameters : 9 13 10 integer nztabul ! # points in tabulation of Tesc & VC (ISO) 11 parameter ( nztabul=79 ) 14 integer,parameter :: nztabul=79 ! # points in tabulation of Tesc & VC (ISO) 12 15 13 16 ! NLTE parameters: 14 17 15 integer nltot! incluye el actual # alt in NLTE module16 parameter ( nltot=20 )! y el # alturas del Tstar11018 integer,parameter :: nltot=20 ! incluye el actual # alt in NLTE module 19 ! y el # alturas del Tstar110 17 20 18 integer nl ! actual # alt in NLTE module & C.Matrix 19 parameter ( nl=12 ) 20 integer nl2 ! = nl-2, needed for matrix inversion (mmh2) 21 parameter ( nl2=nl-2 ) 21 integer,parameter :: nl=12 ! actual # alt in NLTE module & C.Matrix 22 integer,parameter :: nl2=nl-2 ! = nl-2, needed for matrix inversion (mmh2) 22 23 23 integer nzy 24 parameter ( nzy = (nl-1)*4 + 1 ) ! Fine grid for C.Matrix 24 integer,parameter :: nzy = (nl-1)*4 + 1 ! Fine grid for C.Matrix 25 25 26 integer nl_cts ! actual # alt para Tstar110 27 parameter ( nl_cts = 2 + nltot-nl ) 28 integer nzy_cts ! fine grid for transmit calculation 29 parameter ( nzy_cts = (nl_cts-1)*4 + 1 ) 26 integer,parameter :: nl_cts = 2 + nltot-nl ! actual # alt para Tstar110 27 integer,parameter :: nzy_cts = (nl_cts-1)*4 + 1 ! fine grid for transmit calculation 30 28 31 29 32 30 ! Other NLTE parameters: 33 integer nisot ! number of isotopes considered 34 integer nb ! number of bands included 35 parameter ( nisot=4, nb=41 ) 31 integer,parameter :: nisot=4 ! number of isotopes considered 32 integer,parameter :: nb=41 ! number of bands included 36 33 37 integer nhist! # of temps in histogr.38 parameter ( nhist = 36 )! (get it from histograms!)34 integer,parameter :: nhist=36 ! # of temps in histogr. 35 ! (get it from histograms!) 39 36 40 integer nbox_max 41 parameter ( nbox_max = 4 ) ! max.# boxes in histogram 37 integer,parameter :: nbox_max = 4 ! max.# boxes in histogram 42 38 43 39 44 c*** Old tcr_15um.h ***40 ! *** Old tcr_15um.h *** 45 41 46 integer itt_cza ! Selection of NLTE scheme 47 parameter ( itt_cza = 13 ) 42 integer,parameter :: itt_cza = 13 ! Selection of NLTE scheme 48 43 49 real Ptop_atm, Pbottom_atm ! Upper and lower limits of 50 ! NLTE model 51 parameter ( Ptop_atm = 3.e-10 , Pbottom_atm = 2.e-5 ) 52 44 real,parameter :: Ptop_atm = 3.e-10 ! Upper and lower limits of 45 real,parameter :: Pbottom_atm = 2.e-5 ! NLTE model 53 46 54 real*8 rf19,rf20,rf21a,rf21b,rf21c,rf33bc 55 parameter ( rf19 = 1.d0, rf20 = 1.d0, rf21a = 1.d0) 56 parameter ( rf21b = 1.d0, rf21c = 1.d0, rf33bc = 1.d0 ) 47 real*8,parameter :: rf19 = 1.d0, rf20 = 1.d0, rf21a = 1.d0 48 real*8,parameter :: rf21b = 1.d0, rf21c = 1.d0, rf33bc = 1.d0 49 50 ! *** Old bloque_dlvr11.f *** 51 52 real,parameter :: nu(nisot,8) = reshape([& 53 667.3801, 1335.1317, 0., 0., 0., 0., 0., 0., & 54 662.3734, 0., 0., 0., 0., 0., 0., 0., & 55 648.4784, 0., 0., 0., 0., 0., 0., 0., & 56 664.7289, 0., 0., 0., 0., 0., 0., 0. & 57 ],shape(nu),order=[2,1]) 58 ! data nu(1,1),nu(1,2) /667.3801, 1335.1317/ 59 ! data nu(2,1)/662.3734/ 60 ! data nu(3,1)/648.4784/ 61 ! data nu(4,1)/664.7289/ 62 63 real,parameter :: nu12_0200 = 1285.4087 64 real,parameter :: nu12_1000 = 1388.1847 65 66 integer,parameter :: indexisot(nisot) = [26,28,36,27] 67 68 ! ctes en el sistema cgs 69 real*8,parameter :: vlight = 2.9979245e10 70 real*8,parameter :: ee = 1.43876866 71 real*8,parameter :: hplanck = 6.6260755e-27 72 real*8,parameter :: gamma = 1.191043934e-5 57 73 58 74 59 c *** Old bloque_dlvr11.f *** 60 61 real nu(nisot,8) 62 c data 63 data nu(1,1),nu(1,2) /667.3801, 1335.1317/ 64 data nu(2,1)/662.3734/ 65 data nu(3,1)/648.4784/ 66 data nu(4,1)/664.7289/ 67 68 real nu12_0200,nu12_1000 69 parameter (nu12_0200 = 1285.4087) 70 parameter (nu12_1000 = 1388.1847) 71 72 integer indexisot(nisot) 73 data indexisot/26,28,36,27/ 74 75 ! ctes en el sistema cgs 76 real*8 vlight, ee, hplanck, gamma 77 parameter (vlight = 2.9979245e10) 78 parameter (ee = 1.43876866) 79 parameter (hplanck = 6.6260755e-27) 80 parameter (gamma = 1.191043934e-5) 75 ! datos de marte 76 real,parameter :: imr(nisot) = [ 0.987, 0.00408, 0.0112, 0.000742 ] 81 77 82 78 83 ! datos de marte 84 real imr(nisot) 85 data imr / 0.987, 0.00408, 0.0112, 0.000742 / 79 END MODULE nlte_paramdef_h 86 80 87 88 89 -
trunk/LMDZ.MARS/libf/phymars/nlte_setup.F
r2606 r3018 1 ! MODULE nlte_setup_mod 2 3 ! USE nlte_aux_mod 4 5 ! IMPLICIT NONE 6 7 ! CONTAINS 1 8 c*********************************************************************** 2 9 … … 20 27 USE mod_phys_lmdz_para, ONLY: is_master 21 28 USE mod_phys_lmdz_transfert_para, ONLY: bcast 22 29 use nlte_paramdef_h, only: nztabul, nb, nisot, indexisot 30 use nlte_commons_h, only: elow, deltanu, lnpnbtab, tstar11tab 31 use nlte_commons_h, only: tstar21tab, tstar31tab, tstar41tab 32 use nlte_commons_h, only: a1_010_000, a2_010_000, a3_010_000 33 use nlte_commons_h, only: a4_010_000, a1_020_010 34 use nlte_commons_h, only: vc210tab, vc310tab, vc410tab 23 35 implicit none 24 25 include 'nlte_paramdef.h'26 include 'nlte_commons.h'27 28 36 29 37 c*************** … … 119 127 call LeeHISTOGRMS 120 128 121 c end subroutine 122 123 return 124 end 129 end subroutine nlte_setup 125 130 126 131 … … 131 136 132 137 use datafile_mod, only: datadir 133 138 use nlte_commons_h, only: hisfile 134 139 implicit none 135 136 include 'nlte_paramdef.h'137 include 'nlte_commons.h'138 139 140 140 141 c local variables and constants … … 171 172 172 173 173 174 return 175 end 174 end subroutine LeeHISTOGRMS 176 175 177 176 … … 183 182 184 183 c*********************************************************************** 185 184 use nlte_paramdef_h, only: rf19, rf20, rf21a, rf21b, rf21c, rf33bc 185 use nlte_paramdef_h, only: nisot, ee, nu 186 use nlte_commons_h, only: k23k21c, k24k21c ,k34k21c, k23k21cp 187 use nlte_commons_h, only: k24k21cp, k34k21cp 188 use nlte_commons_h, only: k19ba, k19bb, k19bc, k19bap 189 use nlte_commons_h, only: k19bbp, k19bcp, k19ca, k19cb, k19cc 190 use nlte_commons_h, only: k19cap, k19cbp, k19ccp 191 use nlte_commons_h, only: k20b, k20c, k20bp, k20cp 192 use nlte_commons_h, only: k21b, k21c, k21bp, k21cp, k33c, k33cp 186 193 implicit none 187 188 include 'nlte_paramdef.h'189 include 'nlte_commons.h'190 194 191 195 c arguments … … 293 297 end do 294 298 295 296 return 297 end 298 299 300 301 302 303 304 299 end subroutine GETK_dlvr11 300 301 302 ! END MODULE nlte_setup_mod 303 304 305 306 307 -
trunk/LMDZ.MARS/libf/phymars/nlte_tcool.F
r3012 r3018 1 1 MODULE nlte_tcool_mod 2 2 3 3 IMPLICIT NONE 4 4 … … 36 36 37 37 use conc_mod, only: cpnew, mmean 38 use nlte_paramdef_h, only: nl, nltot, nl_cts 39 use nlte_commons_h, only: input_cza, jlowerboundary, jtopcts 40 use nlte_commons_h, only: c110, taustar11, vc110, hr121 41 use nlte_commons_h, only: hr110, hr210, hr310, hr410 42 use nlte_commons_h, only: pl, pl_cts 43 38 44 implicit none 39 40 include 'nlte_paramdef.h'41 include 'nlte_commons.h'42 43 45 44 46 c Arguments … … 211 213 212 214 c*********************************************************************** 213 215 use nlte_paramdef_h, only: nl, nzy, nl_cts, nzy_cts 216 use nlte_paramdef_h, only: Pbottom_atm, Ptop_atm 217 use nlte_commons_h, only: jlowerboundary, jtopboundary, jtopCTS 218 use nlte_commons_h, only: deltaz, deltazy, deltaz_cts, deltazy_cts 219 use nlte_commons_h, only: zl, t, pl, nt, co2, n2, co, o3p 220 use nlte_commons_h, only: co2vmr, n2vmr, covmr, o3pvmr 221 use nlte_commons_h, only: hrkday_factor, zy, ty, py, nty, co2y 222 use nlte_commons_h, only: zy_cts, ty_cts, py_cts, nty_cts 223 use nlte_commons_h, only: co2y_cts, zl_cts, t_cts, pl_cts, nt_cts 224 use nlte_commons_h, only: co2_cts, n2_cts, co_cts, o3p_cts 225 use nlte_commons_h, only: co2vmr_cts, n2vmr_cts, covmr_cts 226 use nlte_commons_h, only: o3pvmr_cts, hrkday_factor_cts 227 use nlte_commons_h, only: mmean_cts, cpnew_cts 228 use nlte_commons_h, only: mm_stored, thist_stored 214 229 implicit none 215 230 216 include 'nlte_paramdef.h'217 include 'nlte_commons.h'218 219 231 c Arguments 220 232 integer n_gcm ! I … … 488 500 489 501 c*********************************************************************** 490 502 use nlte_paramdef_h, only: hplanck, vlight, ee, gamma, itt_cza 503 use nlte_paramdef_h, only: Ptop_atm, Pbottom_atm, nl, nl2, nltot 504 use nlte_paramdef_h, only: nl, nu, imr 505 use nlte_commons_h, only: v626t1, v628t1, v636t1, v627t1 506 use nlte_commons_h, only: a1_020_010, a2_010_000, a3_010_000 507 use nlte_commons_h, only: a4_010_000, input_cza 508 use nlte_commons_h, only: k23k21c, k24k21c, k34k21c, k23k21cp 509 use nlte_commons_h, only: k24k21cp, k34k21cp 510 use nlte_commons_h, only: k19ba, k19bb, k19bc, k19bap, k19bbp 511 use nlte_commons_h, only: k19bcp, k19ca, k19cb, k19cc, k19cap 512 use nlte_commons_h, only: k19cbp, k19ccp, k20b, k20c, k20bp, k20cp 513 use nlte_commons_h, only: k21b, k21c, k21bp, k21cp, k33c, k33cp 514 use nlte_commons_h, only: nu11, nu12, nu121, nu21, nu31, nu41 515 use nlte_commons_h, only: hr110, hr121, hr210, hr310, hr410 516 use nlte_commons_h, only: c110, c121, c210, c310, c410 517 use nlte_commons_h, only: vc110, vc121, vc210, vc310, vc410 518 use nlte_commons_h, only: taustar11, taustar21, taustar31 519 use nlte_commons_h, only: taustar41, taustar12, hrkday_factor 520 use nlte_commons_h, only: t, nt, co2,n2, co, o3p 521 use nlte_commons_h, only: el11, el12, el21, el31, el41 522 use nlte_commons_h, only: sl110, sl121, sl210, sl310, sl410 523 use nlte_commons_h, only: vt11, vt12, vt21, vt31, vt41 491 524 implicit none 492 493 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!common variables and constants494 495 include 'nlte_paramdef.h'496 include 'nlte_commons.h'497 498 525 499 526 c Arguments … … 1269 1296 1270 1297 c*********************************************************************** 1271 1298 use nlte_paramdef_h, only: nl_cts, nu, imr, hplanck, vlight 1299 use nlte_commons_h, only: nu11, t_cts, nt_cts, taustar11_cts 1300 use nlte_commons_h, only: co2_cts, n2_cts, co_cts, o3p_cts 1301 use nlte_commons_h, only: hrkday_factor_cts, a1_010_000 1302 use nlte_commons_h, only: k19ba, k19bb, k19bc, k19bap, k19bbp 1303 use nlte_commons_h, only: k19bcp, k19ca, k19cb, k19cc, k19cap 1304 use nlte_commons_h, only: k19cbp, k19ccp 1305 use nlte_commons_h, only: k20c, k20cp 1272 1306 implicit none 1273 1274 !!!!!!!!!!!!!!!!!! common variables and constants1275 1276 include 'nlte_paramdef.h'1277 include 'nlte_commons.h'1278 1279 1307 1280 1308 c Arguments
Note: See TracChangeset
for help on using the changeset viewer.
