Changeset 766 for LMDZ4/trunk/libf/phylmd/clmain.F
- Timestamp:
- Jun 4, 2007, 4:34:47 PM (17 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/trunk/libf/phylmd/clmain.F
r686 r766 4 4 c 5 5 c 6 #define IO_DISCONNECTED 7 6 8 SUBROUTINE clmain(dtime,itap,date0,pctsrf,pctsrf_new, 7 9 . t,q,u,v, … … 24 26 . pblh,capCL,oliqCL,cteiCL,pblT, 25 27 . therm,trmb1,trmb2,trmb3,plcl, 26 . fqcalving,f fonte, run_off_lic_0,28 . fqcalving,fqfonte,ffonte, run_off_lic_0, 27 29 cIM "slab" ocean 28 30 . flux_o, flux_g, tslab, seaice) … … 45 47 USE ioipsl 46 48 USE interface_surf 49 USE dimphy 47 50 IMPLICIT none 48 51 c====================================================================== … … 85 88 ccc 86 89 c ffonte----Flux thermique utilise pour fondre la neige 90 c fqfonte -- quantite d'eau due a la fonte de la calotte 87 91 c fqcalving-Flux d'eau "perdue" par la surface et necessaire pour limiter la 88 92 c hauteur de neige, en kg/m2/s … … 105 109 c pblT------- T au nveau HCL 106 110 c====================================================================== 107 #include "dimensions.h"108 #include "dimphy.h"111 cym#include "dimensions.h" 112 cym#include "dimphy.h" 109 113 #include "indicesol.h" 110 c $$$PB ajout pour soil114 cxxx PB ajout pour soil 111 115 #include "dimsoil.h" 112 116 #include "iniprint.h" … … 133 137 REAL amn, amx 134 138 cIM cf JLD 135 REAL y_fqcalving(klon), y_f fonte(klon)136 REAL fqcalving(klon,nbsrf), f fonte(klon,nbsrf)139 REAL y_fqcalving(klon), y_fqfonte(klon), y_ffonte(klon) 140 REAL fqcalving(klon,nbsrf), fqfonte(klon,nbsrf),ffonte(klon,nbsrf) 137 141 REAL run_off_lic_0(klon), y_run_off_lic_0(klon) 138 142 … … 159 163 REAL albe(klon,nbsrf) 160 164 REAL alblw(klon,nbsrf) 161 c $$$PB165 cxxx PB 162 166 REAL fluxlat(klon,nbsrf) 163 167 C … … 174 178 REAL zv1(klon) 175 179 cAA 176 c $$$PB ajout pour soil180 cxxx PB ajout pour soil 177 181 LOGICAL soil_model 178 182 cIM ajout seuils cdrm, cdrh … … 197 201 real yfder(klon), ytaux(klon), ytauy(klon) 198 202 REAL yrugm(klon), yrads(klon),yrugoro(klon) 199 c $$$PB203 cxxx PB 200 204 REAL yfluxlat(klon) 201 205 C … … 248 252 CHARACTER*80 cldebug 249 253 SAVE cldebug 254 c$OMP THREADPRIVATE(cldebug) 250 255 CHARACTER*8 cl_surf(nbsrf) 251 256 SAVE cl_surf 257 c$OMP THREADPRIVATE(cl_surf) 252 258 INTEGER nhoridbg, nidbg 253 259 SAVE nhoridbg, nidbg 260 c$OMP THREADPRIVATE(nhoridbg, nidbg) 261 #ifndef IO_DISCONNECTED 254 262 INTEGER ndexbg(iim*(jjm+1)) 255 263 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1), zjulian 256 264 REAL tabindx(klon) 257 265 REAL debugtab(iim,jjm+1) 266 #endif 258 267 LOGICAL first_appel 259 268 SAVE first_appel 260 269 DATA first_appel/.true./ 270 c$OMP THREADPRIVATE(first_appel) 261 271 LOGICAL debugindex 262 272 SAVE debugindex 263 273 DATA debugindex/.false./ 274 c$OMP THREADPRIVATE(debugindex) 264 275 integer idayref 265 276 #include "temps.h" … … 327 338 call flush(6) 328 339 endif 329 IF ( debugindex .and.first_appel) THEN330 first_appel=.false.340 IF (first_appel) THEN 341 ! first_appel=.false. 331 342 ! 332 343 ! initialisation sorties netcdf 333 344 ! 345 #ifndef IO_DISCONNECTED 334 346 idayref = day_ini 335 347 CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian) … … 355 367 CALL histend(nidbg) 356 368 CALL histsync(nidbg) 369 #endif 357 370 ENDIF 358 371 … … 409 422 y_flux_u = 0.0 410 423 y_flux_v = 0.0 411 C $$PB424 Cxx PB 412 425 y_dflux_t = 0.0 413 426 y_dflux_q = 0.0 … … 424 437 ENDDO 425 438 END DO 426 C §§§PB439 C PB 427 440 yfluxlat=0. 428 441 flux_t = 0. … … 434 447 d_t(i,k) = 0.0 435 448 d_q(i,k) = 0.0 436 c $$$flux_t(i,k) = 0.0437 c $$$flux_q(i,k) = 0.0449 cxxx flux_t(i,k) = 0.0 450 cxxx flux_q(i,k) = 0.0 438 451 d_u(i,k) = 0.0 439 452 d_v(i,k) = 0.0 440 c $$$flux_u(i,k) = 0.0441 c $$$flux_v(i,k) = 0.0453 cxxx flux_u(i,k) = 0.0 454 cxxx flux_v(i,k) = 0.0 442 455 zcoefh(i,k) = 0.0 443 456 ENDDO … … 488 501 c variables pour avoir une sortie IOIPSL des INDEX 489 502 c 503 #ifndef IO_DISCONNECTED 490 504 IF (debugindex) THEN 491 505 tabindx(:)=0. 492 506 c tabindx(1:knon)=(/FLOAT(i),i=1:knon/) 493 507 DO i=1,knon 494 tabindx( 1:knon)=FLOAT(i)508 tabindx(i)=FLOAT(i) 495 509 END DO 496 510 debugtab(:,:)=0. … … 500 514 $ ,ndexbg) 501 515 ENDIF 502 IF (knon.EQ.0) GOTO 99999 516 #endif 517 518 fluxlat(:,nsrf) = 0. 519 520 cym IF (knon.EQ.0) GOTO 99999 503 521 DO j = 1, knon 504 522 i = ni(j) … … 546 564 yqsol(:)=0. 547 565 ENDIF 548 c $$$PB ajour pour soil566 cxxx PB ajour pour soil 549 567 DO k = 1, nsoilmx 550 568 DO j = 1, knon … … 567 585 c 568 586 c 587 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 569 588 c calculer Cdrag et les coefficients d'echange 589 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 590 591 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 592 c Calcul anciens du LMD. Effectues de toutes facons. 593 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 594 570 595 CALL coefkz(nsrf, knon, ypaprs, ypplay, 571 596 cIM 261103 … … 705 730 706 731 c FH modif sur le cdrag temperature 707 c $$$PB : déplace dans clcdrag708 c $$$do i=1,knon709 c $$$ycoefh(i,1)=ycoefm(i,1)*0.8710 c $$$enddo732 cxxxPB : d�lace dans clcdrag 733 cxxx do i=1,knon 734 cxxx ycoefh(i,1)=ycoefm(i,1)*0.8 735 cxxx enddo 711 736 712 737 cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc … … 726 751 e ywindsp, 727 752 c -- LOOP 728 c $$$e ysollw, ysolsw,753 cxxx e ysollw, ysolsw, 729 754 e ysollw, ysollwdown, ysolsw,yfluxlat, 730 755 s pctsrf_new, yagesno, 731 756 s y_d_t, y_d_q, y_d_ts, yz0_new, 732 757 s y_flux_t, y_flux_q, y_dflux_t, y_dflux_q, 733 s y_fqcalving,y_f fonte,y_run_off_lic_0,758 s y_fqcalving,y_fqfonte,y_ffonte,y_run_off_lic_0, 734 759 cIM "slab" ocean 735 760 s y_flux_o, y_flux_g, ytslab, y_seaice) … … 758 783 y_d_t(j,k) = y_d_t(j,k) * ypct(j) 759 784 y_d_q(j,k) = y_d_q(j,k) * ypct(j) 760 C §§§PB785 C PB 761 786 flux_t(i,k,nsrf) = y_flux_t(j,k) 762 787 flux_q(i,k,nsrf) = y_flux_q(j,k) 763 788 flux_u(i,k,nsrf) = y_flux_u(j,k) 764 789 flux_v(i,k,nsrf) = y_flux_v(j,k) 765 c $$$PB y_flux_t(j,k) = y_flux_t(j,k) * ypct(j)766 c $$$PB y_flux_q(j,k) = y_flux_q(j,k) * ypct(j)790 cxxx PB y_flux_t(j,k) = y_flux_t(j,k) * ypct(j) 791 cxxx PB y_flux_q(j,k) = y_flux_q(j,k) * ypct(j) 767 792 y_d_u(j,k) = y_d_u(j,k) * ypct(j) 768 793 y_d_v(j,k) = y_d_v(j,k) * ypct(j) 769 c $$$PB y_flux_u(j,k) = y_flux_u(j,k) * ypct(j)770 c $$$PB y_flux_v(j,k) = y_flux_v(j,k) * ypct(j)794 cxxx PB y_flux_u(j,k) = y_flux_u(j,k) * ypct(j) 795 cxxx PB y_flux_v(j,k) = y_flux_v(j,k) * ypct(j) 771 796 ENDDO 772 797 ENDDO … … 790 815 rugos(i,nsrf) = yz0_new(j) 791 816 fluxlat(i,nsrf) = yfluxlat(j) 792 c $$$pb rugmer(i) = yrugm(j)817 cxxx pb rugmer(i) = yrugm(j) 793 818 IF (nsrf .EQ. is_oce) then 794 819 rugmer(i) = yrugm(j) … … 798 823 agesno(i,nsrf) = yagesno(j) 799 824 fqcalving(i,nsrf) = y_fqcalving(j) 825 fqfonte(i,nsrf) = y_fqfonte(j) 800 826 ffonte(i,nsrf) = y_ffonte(j) 801 827 cdragh(i) = cdragh(i) + ycoefh(j,1) … … 818 844 END DO 819 845 END IF 820 c $$$ PB ajout pour soil846 c@$$ PB ajout pour soil 821 847 ftsoil(:,:,nsrf) = 0. 822 848 DO k = 1, nsoilmx … … 838 864 d_t(i,k) = d_t(i,k) + y_d_t(j,k) 839 865 d_q(i,k) = d_q(i,k) + y_d_q(j,k) 840 c $$$ PB flux_t(i,k) = flux_t(i,k) + y_flux_t(j,k)841 c $$$ flux_q(i,k) = flux_q(i,k) + y_flux_q(j,k)866 c@$$ PB flux_t(i,k) = flux_t(i,k) + y_flux_t(j,k) 867 c@$$ flux_q(i,k) = flux_q(i,k) + y_flux_q(j,k) 842 868 d_u(i,k) = d_u(i,k) + y_d_u(j,k) 843 869 d_v(i,k) = d_v(i,k) + y_d_v(j,k) 844 c $$$ PB flux_u(i,k) = flux_u(i,k) + y_flux_u(j,k)845 c $$$ flux_v(i,k) = flux_v(i,k) + y_flux_v(j,k)870 c@$$ PB flux_u(i,k) = flux_u(i,k) + y_flux_u(j,k) 871 c@$$ flux_v(i,k) = flux_v(i,k) + y_flux_v(j,k) 846 872 zcoefh(i,k) = zcoefh(i,k) + ycoefh(j,k) 847 873 ENDDO … … 1013 1039 s d_t, d_q, d_ts, z0_new, 1014 1040 s flux_t, flux_q,dflux_s,dflux_l, 1015 s fqcalving,f fonte,run_off_lic_0,1041 s fqcalving,fqfonte,ffonte,run_off_lic_0, 1016 1042 cIM "slab" ocean 1017 1043 s flux_o,flux_g,tslab,seaice) 1018 1044 1019 1045 USE interface_surf 1020 1046 USE dimphy 1021 1047 IMPLICIT none 1022 1048 c====================================================================== … … 1025 1051 c====================================================================== 1026 1052 #include "dimensions.h" 1027 #include "dimphy.h"1053 cym#include "dimphy.h" 1028 1054 #include "YOMCST.h" 1029 1055 #include "YOETHF.h" … … 1089 1115 c Flux thermique utiliser pour fondre la neige 1090 1116 REAL ffonte(klon) 1091 c Flux d'eau "perdu e" par la surface et nécessaire pour que limiter la1117 c Flux d'eau "perdu" par la surface et n�essaire pour que limiter la 1092 1118 c hauteur de neige, en kg/m2/s 1093 1119 REAL fqcalving(klon) 1120 c Quantite d'eau de fonte de la calotte kg/m?s 1121 REAL fqfonte(klon) 1094 1122 cIM "slab" ocean 1095 1123 REAL tslab(klon) !temperature du slab ocean (K) (OCEAN='slab ') … … 1139 1167 real sollw(klon), sollwdown(klon), swnet(klon), swdown(klon) 1140 1168 real p1lay(klon) 1141 c $$$C PB ajout pour soil1169 c@$$C PB ajout pour soil 1142 1170 LOGICAL soil_model 1143 1171 REAL tsoil(klon, nsoilmx) … … 1325 1353 s evap, fluxsens, fluxlat, dflux_l, dflux_s, 1326 1354 s tsol_rad, tsurf_new, alb_new, alblw, emis_new, z0_new, 1327 s pctsrf_new, agesno,fqcalving,f fonte, run_off_lic_0,1355 s pctsrf_new, agesno,fqcalving,fqfonte,ffonte, run_off_lic_0, 1328 1356 cIM "slab" ocean 1329 1357 s flux_o, flux_g, tslab, seaice) … … 1375 1403 e paprs,pplay,delp, 1376 1404 s d_ven,flux_v) 1405 use dimphy 1377 1406 IMPLICIT none 1378 1407 c====================================================================== … … 1397 1426 c flux_v---output-R- (diagnostic) flux du vent: (kg m/s)/(m**2 s) 1398 1427 c====================================================================== 1399 #include "dimensions.h"1400 #include "dimphy.h"1428 cym#include "dimensions.h" 1429 cym#include "dimphy.h" 1401 1430 #include "iniprint.h" 1402 1431 INTEGER knon … … 1500 1529 . qsurf, 1501 1530 . pcfm, pcfh) 1531 USE dimphy 1502 1532 IMPLICIT none 1503 1533 c====================================================================== … … 1522 1552 c pcfh-----output-R- coefficients a calculer (chaleur et humidite) 1523 1553 c====================================================================== 1524 #include "dimensions.h"1525 #include "dimphy.h"1554 cym#include "dimensions.h" 1555 cym#include "dimphy.h" 1526 1556 #include "YOMCST.h" 1527 1557 #include "indicesol.h" … … 1569 1599 PARAMETER (mixlen=35.0) 1570 1600 INTEGER isommet ! le sommet de la couche limite 1571 PARAMETER (isommet=klev)1601 cym PARAMETER (isommet=klev) 1572 1602 LOGICAL tvirtu ! calculer Ri d'une maniere plus performante 1573 1603 PARAMETER (tvirtu=.TRUE.) … … 1604 1634 LOGICAL appel1er 1605 1635 SAVE appel1er 1636 c$OMP THREADPRIVATE(appel1er) 1606 1637 c 1607 1638 c Fonctions thermodynamiques et fonctions d'instabilite … … 1617 1648 DATA appel1er /.TRUE./ 1618 1649 c 1650 cym 1651 isommet=klev 1652 1619 1653 IF (appel1er) THEN 1620 1654 if (prt_level > 9) THEN … … 1820 1854 SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t, 1821 1855 . pcfm, pcfh) 1856 USE dimphy 1822 1857 IMPLICIT none 1823 1858 c====================================================================== … … 1836 1871 c pcfh-----output-R- coefficients a calculer (chaleur et humidite) 1837 1872 c====================================================================== 1838 #include "dimensions.h"1839 #include "dimphy.h"1873 cym#include "dimensions.h" 1874 cym#include "dimphy.h" 1840 1875 #include "YOMCST.h" 1841 1876 #include "indicesol.h" … … 1923 1958 SUBROUTINE calbeta(dtime,indice,knon,snow,qsol, 1924 1959 . vbeta,vcal,vdif) 1960 USE dimphy 1925 1961 IMPLICIT none 1926 1962 c====================================================================== … … 1931 1967 c Calculer quelques parametres pour appliquer la couche limite 1932 1968 c ------------------------------------------------------------ 1933 #include "dimensions.h"1934 #include "dimphy.h"1969 cym#include "dimensions.h" 1970 cym#include "dimphy.h" 1935 1971 #include "YOMCST.h" 1936 1972 #include "indicesol.h" … … 2000 2036 . tsol,beta,u,v,t,q, 2001 2037 . cd_h, cd_m, pcfh, pcfm, cgh, cgq) 2038 USE dimphy 2002 2039 IMPLICIT none 2003 2040 c====================================================================== … … 2014 2051 c model. J. of Climate, vol. 6, 1825-1842. 2015 2052 c====================================================================== 2016 #include "dimensions.h"2017 #include "dimphy.h"2053 cym#include "dimensions.h" 2054 cym#include "dimphy.h" 2018 2055 #include "YOMCST.h" 2019 2056 #include "iniprint.h" … … 2034 2071 c 2035 2072 INTEGER isommet 2036 PARAMETER (isommet=klev)2073 cym PARAMETER (isommet=klev) 2037 2074 REAL vk 2038 2075 PARAMETER (vk=0.40) … … 2110 2147 c Initialisation 2111 2148 c 2149 cym 2150 isommet=klev 2151 2112 2152 DO i = 1, klon 2113 2153 pcfh(i,1) = cd_h(i)
Note: See TracChangeset
for help on using the changeset viewer.