Changeset 5791 for LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90
- Timestamp:
- Jul 28, 2025, 7:23:15 PM (6 days ago)
- Location:
- LMDZ6/branches/contrails
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
libf/phylmd/cv3_routines.f90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/contrails
- Property svn:mergeinfo changed
/LMDZ6/trunk merged: 5654-5683,5685-5690,5692-5715,5718-5721,5726-5727,5729,5744-5761,5763-5778,5780,5785-5789
- Property svn:mergeinfo changed
-
LMDZ6/branches/contrails/libf/phylmd/cv3_routines.f90
r5717 r5791 1 1 2 2 ! $Id$ 3 4 5 3 MODULE cv3_routines_mod 4 PRIVATE 5 ! for cv3_feed 6 LOGICAL, SAVE :: cv3_feed_first =.TRUE. 7 LOGICAL, SAVE :: ok_new_feed 8 !$OMP THREADPRIVATE (cv3_feed_first,ok_new_feed) 9 PUBLIC cv3_param, cv3_incrcount, cv3_prelim, cv3_feed, cv3_undilute1, cv3_trigger, cv3_compress, & 10 icefrac, cv3_undilute2, cv3_closure, cv3_mixing, cv3_unsat, cv3_yield, cv3_tracer, cv3_uncompress,& 11 cv3_epmax_fn_cape, cv3_routine_pre 12 CONTAINS 13 14 SUBROUTINE cv3_routine_pre(ok_conserv_q) 15 LOGICAL, INTENT (IN) :: ok_conserv_q 16 17 CALL cv3_feed_pre(ok_conserv_q) 18 19 END SUBROUTINE cv3_routine_pre 6 20 7 21 SUBROUTINE cv3_param(nd, k_upper, delt) … … 12 26 USE conema3_mod_h 13 27 USE lmdz_cv_ini, ONLY : alpha,alpha1,beta,betad,coef_peel,cv_flag_feed,delta,dpbase,dtcrit,dtovsh,dttrig,ejectice,ejectliq,elcrit,flag_epkeorig,flag_wb,minorig,nl,nlm,nlp,noconv_stop,noff,omtrain,pbcrit,ptcrit,sigdz,spfac,t_top_max,tau,tau_stop,tlcrit,wbmax 14 USE lmdz_cv_ini, ONLY : keep_bug_indices_cv3_tracer 28 USE lmdz_cv_ini, ONLY : keep_bug_indices_cv3_tracer,restore_bug_cvdn 15 29 16 30 … … 45 59 46 60 ! Local variables 47 CHARACTER (LEN=20) :: modname = 'cv3_param'61 CHARACTER (LEN=20),PARAMETER :: modname = 'cv3_param' 48 62 CHARACTER (LEN=80) :: abort_message 49 63 … … 142 156 keep_bug_indices_cv3_tracer = .FALSE. 143 157 CALL getin_p('keep_bug_indices_cv3_tracer', keep_bug_indices_cv3_tracer) 158 restore_bug_cvdn=.false. 159 CALL getin_p('restore_bug_cvdn',restore_bug_cvdn) 144 160 145 161 … … 169 185 WRITE (*, *) 'keepbug_ice_frac =', keepbug_ice_frac 170 186 WRITE (*, *) 'keep_bug_indices_cv3_tracer =', keep_bug_indices_cv3_tracer 187 WRITE (*, *) 'restore_bug_cvdn=',restore_bug_cvdn 171 188 172 189 first = .FALSE. … … 304 321 END SUBROUTINE cv3_prelim 305 322 323 324 SUBROUTINE cv3_feed_pre(ok_conserv_q) 325 USE mod_phys_lmdz_transfert_para, ONLY : bcast 326 IMPLICIT NONE 327 LOGICAL, INTENT (IN) :: ok_conserv_q 328 INTEGER :: iostat 329 330 IF (cv3_feed_first) THEN 331 332 !$OMP MASTER 333 ok_new_feed = ok_conserv_q 334 OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat) 335 IF (iostat==0) THEN 336 READ (98, *, END=998) ok_new_feed 337 998 CONTINUE 338 CLOSE (98) 339 END IF 340 PRINT *, ' ok_new_feed: ', ok_new_feed 341 !$OMP END MASTER 342 call bcast(ok_new_feed) 343 cv3_feed_first = .FALSE. 344 END IF 345 346 END SUBROUTINE cv3_feed_pre 347 348 306 349 SUBROUTINE cv3_feed(len, nd, ok_conserv_q, & 307 350 t, q, u, v, p, ph, h, gz, & … … 310 353 cpnk, hnk, nk, icb, icbmax, iflag, gznk, plcl) 311 354 312 USE mod_phys_lmdz_transfert_para, ONLY : bcast313 355 USE add_phys_tend_mod, ONLY: fl_cor_ebil 314 356 USE print_control_mod, ONLY: prt_level 315 357 USE lmdz_cv_ini, ONLY : cpd,cpv,cv_flag_feed,minorig,nl,nlm,cl 358 USE cv3_estatmix_mod, ONLY : cv3_estatmix 359 USE cv3_enthalpmix_mod, ONLY : cv3_enthalpmix 316 360 IMPLICIT NONE 317 361 … … 362 406 363 407 !jyg20140217< 364 INTEGER iostat 365 LOGICAL, SAVE :: first 366 LOGICAL, SAVE :: ok_new_feed 367 REAL, SAVE :: dp_lcl_feed 368 !$OMP THREADPRIVATE (first,ok_new_feed,dp_lcl_feed) 369 DATA first/.TRUE./ 370 DATA dp_lcl_feed/2./ 371 372 IF (first) THEN 373 !$OMP MASTER 374 ok_new_feed = ok_conserv_q 375 OPEN (98, FILE='cv3feed_param.data', STATUS='old', FORM='formatted', IOSTAT=iostat) 376 IF (iostat==0) THEN 377 READ (98, *, END=998) ok_new_feed 378 998 CONTINUE 379 CLOSE (98) 380 END IF 381 PRINT *, ' ok_new_feed: ', ok_new_feed 382 !$OMP END MASTER 383 call bcast(ok_new_feed) 384 first = .FALSE. 385 END IF 408 REAL, PARAMETER :: dp_lcl_feed = 2. 409 386 410 !jyg> 387 411 ! ------------------------------------------------------------------- … … 590 614 591 615 ! Compute icbmax. 592 616 617 !ym do not do that, independance between column ! 593 618 icbmax = 2 594 619 DO i = 1, len … … 676 701 677 702 ! Re-compute icbsmax (icbsmax2): !convect3 678 ! !convect3 679 icbsmax2 = 2 !convect3 680 DO i = 1, len !convect3 681 icbsmax2 = max(icbsmax2, icbs(i)) !convect3 682 END DO !convect3 703 ! 704 !ym column independant, do not use reduction !convect3 705 !ym icbsmax2 = 2 !convect3 706 !ym DO i = 1, len !convect3 707 !ym icbsmax2 = max(icbsmax2, icbs(i)) !convect3 708 !ym END DO !convect3 683 709 684 710 ! initialization outputs: 685 711 686 DO k = 1, icbsmax2 ! convect3 712 !ym DO k = 1, icbsmax2 ! convect3 713 DO k = 1, nd ! convect3 687 714 DO i = 1, len ! convect3 688 tp(i, k) = 0.0 ! convect3 689 tvp(i, k) = 0.0 ! convect3 690 clw(i, k) = 0.0 ! convect3 715 IF (k<=MAX(2,icbs(i))) THEN 716 tp(i, k) = 0.0 ! convect3 717 tvp(i, k) = 0.0 ! convect3 718 clw(i, k) = 0.0 ! convect3 719 ENDIF 691 720 END DO ! convect3 692 721 END DO ! convect3 … … 694 723 ! tp and tvp below cloud base: 695 724 696 DO k = minorig, icbsmax2 - 1 725 !ym DO k = minorig, icbsmax2 - 1 726 DO k = minorig, nd 697 727 DO i = 1, len 698 tp(i, k) = tnk(i) - (gz(i,k)-gznk(i))*cpinv(i) 699 tvp(i, k) = tp(i, k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3) 728 IF (k<=MAX(2,icbs(i))-1) THEN 729 tp(i, k) = tnk(i) - (gz(i,k)-gznk(i))*cpinv(i) 730 tvp(i, k) = tp(i, k)*(1.+qnk(i)/eps-qnk(i)) !whole thing (convect3) 731 ENDIF 700 732 END DO 701 733 END DO … … 1207 1239 REAL :: fracg 1208 1240 REAL :: deltap 1209 REAL, SAVE :: Tx, Tm 1210 DATA Tx/263.15/, Tm/243.15/ 1211 !$OMP THREADPRIVATE(Tx, Tm) 1241 REAL, PARAMETER :: Tx=263.15 1242 REAL, PARAMETER :: Tm=243.15 1212 1243 REAL :: aa, bb, dd, ddelta, discr 1213 1244 REAL :: ff, fp … … 2103 2134 ! compute icbmax: 2104 2135 2105 icbmax = 22106 DO i = 1, ncum2107 icbmax = max(icbmax, icb(i))2108 END DO2136 !ym icbmax = 2 2137 !ym DO i = 1, ncum 2138 !ym icbmax = max(icbmax, icb(i)) 2139 !ym END DO 2109 2140 2110 2141 ! update sig and w0 below cloud base: 2111 2142 2112 DO k = 1, icbmax 2143 !ym DO k = 1, icbmax 2144 DO k = 1, nd 2113 2145 DO i = 1, ncum 2114 IF (k<=icb(i)) THEN 2115 sig(i, k) = beta*sig(i, k) - & 2116 2.*alpha*buoy(i, icb(i))*buoy(i, icb(i)) 2117 sig(i, k) = max(sig(i,k), 0.0) 2118 w0(i, k) = beta*w0(i, k) 2119 END IF 2146 IF (k<=MAX(2,icb(i))) THEN 2147 IF (k<=icb(i)) THEN 2148 sig(i, k) = beta*sig(i, k) - & 2149 2.*alpha*buoy(i, icb(i))*buoy(i, icb(i)) 2150 sig(i, k) = max(sig(i,k), 0.0) 2151 w0(i, k) = beta*w0(i, k) 2152 END IF 2153 ENDIF 2120 2154 END DO 2121 2155 END DO … … 2332 2366 ! ori do 360 i=1,ncum*nlp 2333 2367 DO j = 1, nl 2334 DO i = 1, ncum2335 nent(i , j) = 02368 DO il = 1, ncum 2369 nent(il, j) = 0 2336 2370 ! in convect3, m is computed in cv3_closure 2337 2371 ! ori m(i,1)=0.0 … … 2343 2377 DO j = 1, nl 2344 2378 DO k = 1, nl 2345 DO i = 1, ncum2346 qent(i , k, j) = rr(i, j)2347 uent(i , k, j) = u(i, j)2348 vent(i , k, j) = v(i, j)2349 elij(i , k, j) = 0.02379 DO il = 1, ncum 2380 qent(il, k, j) = rr(il, j) 2381 uent(il, k, j) = u(il, j) 2382 vent(il, k, j) = v(il, j) 2383 elij(il, k, j) = 0.0 2350 2384 !ym ment(i,k,j)=0.0 2351 2385 !ym sij(i,k,j)=0.0 … … 2497 2531 ! --- TO REPRESENT EQUAL PROBABILITIES OF MIXING 2498 2532 ! ===================================================================== 2499 2500 CALL zilch(asum, nloc*nd) 2501 CALL zilch(csum, nloc*nd) 2502 CALL zilch(csum, nloc*nd) 2533 asum(1:nloc,1:nd) = 0. 2534 csum(1:nloc,1:nd) = 0. 2503 2535 2504 2536 DO il = 1, ncum … … 2512 2544 IF (i>=icb(il) .AND. i<=inb(il)) num1 = num1 + 1 2513 2545 END DO 2514 IF (num1<=0) GO TO 7892515 2546 !ym IF (num1<=0) GO TO 789 2547 IF (num1<=0) CYCLE 2516 2548 2517 2549 DO il = 1, ncum … … 2551 2583 lwork(il)) num2 = num2 + 1 2552 2584 END DO 2553 IF (num2<=0) GO TO 175 2585 !ym IF (num2<=0) GO TO 175 2586 IF (num2<=0) CYCLE 2554 2587 2555 2588 DO il = 1, ncum … … 2665 2698 2666 2699 ! MAF: renormalisation de MENT 2667 CALL zilch(zm, nloc*na) 2700 zm(1:nloc,1:na) = 0. 2701 2668 2702 DO jm = 1, nl 2669 2703 DO im = 1, nl … … 2894 2928 IF (i<=inb(il) .AND. lwork(il)) num1 = num1 + 1 2895 2929 END DO 2896 IF (num1<=0) GO TO 400 2897 2898 CALL zilch(wdtrain, ncum) 2930 !ym IF (num1<=0) GO TO 400 2931 IF (num1<=0) CYCLE 2932 2933 wdtrain(1:ncum) = 0.0 2899 2934 2900 2935 … … 3457 3492 USE cvflag_mod_h 3458 3493 USE lmdz_cv_ini, ONLY : grav,minorig,nl,nlp,rowl,rrd,nl,ci,cl,cpd,cpv 3494 USE lmdz_cv_ini, ONLY : restore_bug_cvdn 3495 3459 3496 IMPLICIT NONE 3460 3497 … … 4025 4062 IF (i<=inb(il) .AND. iflag(il)<=1) num1 = num1 + 1 4026 4063 END DO 4027 IF (num1<=0) GO TO 500 4064 !ym IF (num1<=0) GO TO 500 4065 IF (num1<=0) CYCLE 4028 4066 4029 4067 ! … … 4032 4070 IF (ok_optim_yield) THEN !| 4033 4071 !----------------------------------------------------------- 4072 4073 ! Restoring a bug that was found and corrected in svn release 4074 ! 5544; which appears to have a much stronger impact than initially 4075 ! thought 4076 4077 if ( restore_bug_cvdn ) then 4078 DO il = 1, ncum 4079 amp1(il) = upwd(il,i+1) 4080 ad(il) = dnwd(il,i) 4081 ENDDO 4082 else 4034 4083 DO il = 1, ncum 4035 4084 amp1(il) = upwd(il,i+1) 4036 4085 ad(il) = - dnwd(il,i) 4037 4086 ENDDO 4087 endif 4038 4088 !----------------------------------------------------------- 4039 4089 ELSE !(ok_optim_yield) !| … … 5296 5346 end subroutine cv3_epmax_fn_cape 5297 5347 5298 5299 5348 END MODULE cv3_routines_mod 5349
Note: See TracChangeset
for help on using the changeset viewer.
