[1992] | 1 | SUBROUTINE cv3_buoy(nloc, ncum, nd, icb, inb, pbase, plcl, p, ph, ale, cin, & |
---|
| 2 | tv, tvp, buoy) |
---|
| 3 | ! ************************************************************** |
---|
| 4 | ! * |
---|
| 5 | ! CV3_BUOY * |
---|
| 6 | ! Buoyancy corrections to account for ALE * |
---|
| 7 | ! * |
---|
| 8 | ! written by : MOREAU Cecile, 07/08/2003, 15.55.48 * |
---|
| 9 | ! modified by : * |
---|
| 10 | ! ************************************************************** |
---|
[879] | 11 | |
---|
[1992] | 12 | IMPLICIT NONE |
---|
[879] | 13 | |
---|
[1992] | 14 | include "cvthermo.h" |
---|
| 15 | include "cv3param.h" |
---|
[2420] | 16 | include "YOMCST2.h" |
---|
[879] | 17 | |
---|
[1992] | 18 | ! input: |
---|
| 19 | INTEGER ncum, nd, nloc |
---|
| 20 | INTEGER icb(nloc), inb(nloc) |
---|
| 21 | REAL pbase(nloc), plcl(nloc) |
---|
| 22 | REAL p(nloc, nd), ph(nloc, nd+1) |
---|
| 23 | REAL ale(nloc), cin(nloc) |
---|
| 24 | REAL tv(nloc, nd), tvp(nloc, nd) |
---|
[879] | 25 | |
---|
[1992] | 26 | ! output: |
---|
| 27 | REAL buoy(nloc, nd) |
---|
[1515] | 28 | |
---|
[1992] | 29 | ! local variables: |
---|
| 30 | INTEGER il, k |
---|
| 31 | INTEGER kmx(nloc) |
---|
| 32 | REAL bll(nloc), bmx(nloc) |
---|
| 33 | REAL gamma(nloc) |
---|
| 34 | LOGICAL ok(nloc) |
---|
[879] | 35 | |
---|
[1992] | 36 | REAL dgamma |
---|
| 37 | REAL buoymin |
---|
| 38 | PARAMETER (dgamma=2.E-03) !dgamma gamma |
---|
| 39 | PARAMETER (buoymin=2.) |
---|
[980] | 40 | |
---|
[1992] | 41 | LOGICAL fixed_bll |
---|
| 42 | SAVE fixed_bll |
---|
| 43 | DATA fixed_bll/.TRUE./ |
---|
| 44 | !$OMP THREADPRIVATE(fixed_bll) |
---|
[980] | 45 | |
---|
[879] | 46 | |
---|
[1992] | 47 | ! print *,' Ale+cin ',ale(1)+cin(1) |
---|
| 48 | ! -------------------------------------------------------------- |
---|
| 49 | ! Recompute buoyancies |
---|
| 50 | ! -------------------------------------------------------------- |
---|
| 51 | DO k = 1, nl |
---|
| 52 | DO il = 1, ncum |
---|
| 53 | buoy(il, k) = tvp(il, k) - tv(il, k) |
---|
| 54 | END DO |
---|
| 55 | END DO |
---|
[879] | 56 | |
---|
[1992] | 57 | ! ------------------------------------------------------------- |
---|
| 58 | ! -- Compute low level buoyancy ( function of Ale+Cin ) |
---|
| 59 | ! ------------------------------------------------------------- |
---|
| 60 | IF (fixed_bll) THEN |
---|
[879] | 61 | |
---|
[1992] | 62 | DO il = 1, ncum |
---|
| 63 | bll(il) = 0.5 |
---|
| 64 | END DO |
---|
| 65 | ELSE |
---|
[879] | 66 | |
---|
[1992] | 67 | DO il = 1, ncum |
---|
| 68 | IF (ale(il)+cin(il)>0.) THEN |
---|
| 69 | gamma(il) = 4.*buoy(il, icb(il))**2 + 8.*dgamma*(ale(il)+cin(il))*tv( & |
---|
| 70 | il, icb(il))/grav |
---|
| 71 | gamma(il) = max(gamma(il), 1.E-10) |
---|
| 72 | END IF |
---|
| 73 | END DO |
---|
[879] | 74 | |
---|
[1992] | 75 | DO il = 1, ncum |
---|
| 76 | IF (ale(il)+cin(il)>0.) THEN |
---|
| 77 | bll(il) = 4.*dgamma*(ale(il)+cin(il))*tv(il, icb(il))/ & |
---|
| 78 | (grav*(abs(buoy(il,icb(il))+0.5*sqrt(gamma(il))))) |
---|
| 79 | END IF |
---|
| 80 | END DO |
---|
[980] | 81 | |
---|
[1992] | 82 | DO il = 1, ncum |
---|
| 83 | IF (ale(il)+cin(il)>0.) THEN |
---|
| 84 | bll(il) = min(bll(il), buoymin) |
---|
| 85 | END IF |
---|
| 86 | END DO |
---|
[879] | 87 | |
---|
[1992] | 88 | END IF !(fixed_bll) |
---|
[879] | 89 | |
---|
| 90 | |
---|
[1992] | 91 | ! ------------------------------------------------------------- |
---|
| 92 | ! --Get highest buoyancy among levels below LCL-200hPa |
---|
| 93 | ! ------------------------------------------------------------- |
---|
[879] | 94 | |
---|
[1992] | 95 | DO il = 1, ncum |
---|
| 96 | bmx(il) = -1000. |
---|
| 97 | kmx(il) = icb(il) |
---|
| 98 | ok(il) = .TRUE. |
---|
| 99 | END DO |
---|
[879] | 100 | |
---|
[1992] | 101 | DO k = 1, nl |
---|
| 102 | DO il = 1, ncum |
---|
| 103 | IF (ale(il)+cin(il)>0. .AND. ok(il)) THEN |
---|
| 104 | IF (k>icb(il) .AND. k<=inb(il)) THEN |
---|
| 105 | ! c print *,'k,p(il,k),plcl(il)-200. ', |
---|
| 106 | ! k,p(il,k),plcl(il)-200. |
---|
| 107 | IF (p(il,k)>plcl(il)-200.) THEN |
---|
| 108 | IF (buoy(il,k)>bmx(il)) THEN |
---|
| 109 | bmx(il) = buoy(il, k) |
---|
| 110 | kmx(il) = k |
---|
| 111 | IF (bmx(il)>=bll(il)) ok(il) = .FALSE. |
---|
| 112 | END IF |
---|
| 113 | END IF |
---|
| 114 | END IF |
---|
| 115 | END IF |
---|
| 116 | END DO |
---|
| 117 | END DO |
---|
[879] | 118 | |
---|
[1992] | 119 | ! print *,' ==cv3_buoy== bll(1),bmx(1),icb(1),kmx(1) ' |
---|
| 120 | ! $ ,bll(1),bmx(1),icb(1),kmx(1) |
---|
[879] | 121 | |
---|
[1992] | 122 | ! ------------------------------------------------------------- |
---|
| 123 | ! --Calculate modified buoyancies |
---|
| 124 | ! ------------------------------------------------------------- |
---|
[879] | 125 | |
---|
[1992] | 126 | DO il = 1, ncum |
---|
| 127 | IF (ale(il)+cin(il)>0.) THEN |
---|
| 128 | bll(il) = min(bll(il), bmx(il)) |
---|
| 129 | END IF |
---|
| 130 | END DO |
---|
[879] | 131 | |
---|
[1992] | 132 | DO k = 1, nl |
---|
| 133 | DO il = 1, ncum |
---|
| 134 | IF (ale(il)+cin(il)>0.) THEN |
---|
| 135 | IF (k>=icb(il) .AND. k<=kmx(il)-1) THEN |
---|
| 136 | buoy(il, k) = bll(il) |
---|
| 137 | END IF |
---|
| 138 | END IF |
---|
| 139 | END DO |
---|
| 140 | END DO |
---|
| 141 | |
---|
[2420] | 142 | !CR:Correction of buoy for what comes next |
---|
| 143 | !keep flag or to modify in all cases? |
---|
[5082] | 144 | IF (iflag_mix_adiab==1) THEN |
---|
[2420] | 145 | DO k = 1, nl |
---|
| 146 | DO il = 1, ncum |
---|
[5082] | 147 | IF ((k>=kmx(il)) .AND. (k<=inb(il)) .AND. (buoy(il,k)<0.)) THEN |
---|
[2420] | 148 | buoy(il,k)=buoy(il,k-1) |
---|
| 149 | END IF |
---|
| 150 | ENDDO |
---|
| 151 | ENDDO |
---|
| 152 | ENDIF |
---|
[1992] | 153 | |
---|
[5105] | 154 | |
---|
[1992] | 155 | END SUBROUTINE cv3_buoy |
---|