| 1 | SUBROUTINE COOLING(NG,NL,PRESS,TEMP,Z,Q0,lwnet,pfluxi,icld) |
|---|
| 2 | |
|---|
| 3 | c======================================================================= |
|---|
| 4 | c |
|---|
| 5 | c Author : C. P. Mc Kay 01/02/91 |
|---|
| 6 | c ------ |
|---|
| 7 | c |
|---|
| 8 | c Object : |
|---|
| 9 | c -------- |
|---|
| 10 | c |
|---|
| 11 | C THIS SUBROUTINE RETURNS THE COOLING RATE IN TITAN'S ATMOSPHERE |
|---|
| 12 | C INPUTS ARE PRESS(BARS), TEMP(K), Z(KM) |
|---|
| 13 | C OUTPUT IS: Q(K/SEC)C |
|---|
| 14 | C |
|---|
| 15 | C COOLING RATE COMPUTED NEGLECTING SCATTERING. |
|---|
| 16 | C THE TRICK OF THIS ROUTINE IS THAT IT READS IN THE OPACITIES |
|---|
| 17 | C FOR EACH LAYER AT EACH WAVENUMBER IN THE SPECTRAL DOMAIN |
|---|
| 18 | C THESE OPACITIES ARE HELD CONSTANT WITH TEMPERATURE AND TIME. |
|---|
| 19 | c |
|---|
| 20 | c Interface: |
|---|
| 21 | c ---------- |
|---|
| 22 | c |
|---|
| 23 | c Arguments: |
|---|
| 24 | c ---------- |
|---|
| 25 | c |
|---|
| 26 | c input: |
|---|
| 27 | c ------ |
|---|
| 28 | c |
|---|
| 29 | c nl number of levels |
|---|
| 30 | c press(nl) pressure levels (layers) |
|---|
| 31 | c temp(nl) temperature (layers) |
|---|
| 32 | c z(nl) altitude (m, levels) |
|---|
| 33 | c |
|---|
| 34 | c output: |
|---|
| 35 | c ------- |
|---|
| 36 | c |
|---|
| 37 | c q0(nl-1) radiative cooling in K/sec |
|---|
| 38 | c lwnet(nl) net fluxes, (+) upward |
|---|
| 39 | c pfluxi IR descendant a la surface (+ vers le bas) |
|---|
| 40 | c |
|---|
| 41 | c Commons: |
|---|
| 42 | c -------- |
|---|
| 43 | c |
|---|
| 44 | c COMMON/IRTAUS/dtaui(nlayer,nspeci) |
|---|
| 45 | c infrared opacities of the differents layers for differents |
|---|
| 46 | c spectral ranges. This common is initialized by radtitan. |
|---|
| 47 | c |
|---|
| 48 | c======================================================================= |
|---|
| 49 | c----------------------------------------------------------------------- |
|---|
| 50 | c Declarations: |
|---|
| 51 | c ------------ |
|---|
| 52 | |
|---|
| 53 | use dimphy |
|---|
| 54 | IMPLICIT NONE |
|---|
| 55 | #include "dimensions.h" |
|---|
| 56 | #include "YOMCST.h" |
|---|
| 57 | INTEGER NLAYER,NSPECI,NSPC1I |
|---|
| 58 | PARAMETER(NLAYER=llm) |
|---|
| 59 | PARAMETER (NSPECI=46,NSPC1I=47) |
|---|
| 60 | |
|---|
| 61 | c ASTUCE POUR EVITER klon... EN ATTENDANT MIEUX |
|---|
| 62 | INTEGER ngrid |
|---|
| 63 | PARAMETER (ngrid=(jjm-1)*iim+2) ! = klon |
|---|
| 64 | c |
|---|
| 65 | c Arguments: |
|---|
| 66 | c ---------- |
|---|
| 67 | |
|---|
| 68 | INTEGER NG,NL,icld |
|---|
| 69 | REAL PRESS(NG,NL),TEMP(NG,NL) |
|---|
| 70 | REAL Z(NG,NL),Q0(NG,NL-1) |
|---|
| 71 | REAL lwnet(NG,NL),UBARI2 |
|---|
| 72 | real pfluxi(NG) |
|---|
| 73 | |
|---|
| 74 | |
|---|
| 75 | c Common: |
|---|
| 76 | c ------- |
|---|
| 77 | |
|---|
| 78 | C DTAU IS PASSED EN-MASS, SO ITS DEMENSIONS ARE CRITICAL |
|---|
| 79 | REAL dtaui(ngrid,NLAYER,NSPECI) |
|---|
| 80 | REAL dtauip(ngrid,NLAYER,NSPECI) |
|---|
| 81 | COMMON /IRTAUS/ dtaui,dtauip |
|---|
| 82 | |
|---|
| 83 | c Local: |
|---|
| 84 | c ------ |
|---|
| 85 | |
|---|
| 86 | REAL WNOI(NSPECI),DWNI(NSPECI) ! SPECTAL INTERVALS |
|---|
| 87 | REAL B0(ngrid,llm+1) |
|---|
| 88 | REAL EM(ngrid,llm+1) |
|---|
| 89 | REAL DW,WAVEN,TJ,BSURF,QOUT,QIN,eff_g,COLDEN |
|---|
| 90 | |
|---|
| 91 | INTEGER ig,K,J,I,L |
|---|
| 92 | |
|---|
| 93 | c EXTERNAL PLNCK |
|---|
| 94 | REAL PLNCK,zz1,zz2,zz3,zz4,WAVNUM,Xtest |
|---|
| 95 | |
|---|
| 96 | REAL FNETIS(ngrid,llm+1),FNETI(ngrid,llm+1) |
|---|
| 97 | REAL FDIS(ngrid,llm+1,nspeci),FUPIS(ngrid,llm+1,nspeci) |
|---|
| 98 | REAL FDI(ngrid,llm+1), FUPI(ngrid,llm+1) |
|---|
| 99 | |
|---|
| 100 | c Data: |
|---|
| 101 | c ----- |
|---|
| 102 | |
|---|
| 103 | REAL RHOP,CSUBP,UBARI,RSFI |
|---|
| 104 | DATA RHOP/1.E4/ ! CONVERSION FROM PRESSURE TO MASS |
|---|
| 105 | DATA UBARI/0.5/ ! MEAN COSINE FOR 2-STREAM |
|---|
| 106 | DATA RSFI/0.0/ ! SURFACE ALBEDO |
|---|
| 107 | DATA WNOI/ |
|---|
| 108 | & 11.500, 20.000, 31.250, 50.000, 75.000, |
|---|
| 109 | & 100.000, 125.000, 150.000, 175.000, 200.000, |
|---|
| 110 | & 225.000, 250.000, 275.000, 300.000, 325.000, |
|---|
| 111 | & 350.000, 375.000, 400.000, 425.000, 450.000, |
|---|
| 112 | & 475.000, 500.000, 525.000, 550.000, 575.000, |
|---|
| 113 | & 600.000, 628.750, 662.838, 681.757, 683.919, |
|---|
| 114 | & 686.541, 689.623, 692.704, 695.786, 715.141, |
|---|
| 115 | & 733.836, 735.597, 737.358, 739.119, 742.720, |
|---|
| 116 | & 748.160, 753.600, 834.560, 917.333, 926.400, |
|---|
| 117 | & 935.466/ |
|---|
| 118 | DATA DWNI/ |
|---|
| 119 | & 7.000, 10.000, 12.500, 25.000, 25.000, |
|---|
| 120 | & 25.000, 25.000, 25.000, 25.000, 25.000, |
|---|
| 121 | & 25.000, 25.000, 25.000, 25.000, 25.000, |
|---|
| 122 | & 25.000, 25.000, 25.000, 25.000, 25.000, |
|---|
| 123 | & 25.000, 25.000, 25.000, 25.000, 25.000, |
|---|
| 124 | & 25.000, 32.500, 35.676, 2.162, 2.162, |
|---|
| 125 | & 3.082, 3.082, 3.082, 3.082, 35.629, |
|---|
| 126 | & 1.761, 1.761, 1.761, 1.761, 5.440, |
|---|
| 127 | & 5.440, 5.440, 156.480, 9.067, 9.067, |
|---|
| 128 | & 9.067/ |
|---|
| 129 | |
|---|
| 130 | |
|---|
| 131 | save RHOP,UBARI,RSFI,WNOI,DWNI |
|---|
| 132 | |
|---|
| 133 | c----------------------------------------------------------------------- |
|---|
| 134 | |
|---|
| 135 | c Initialisations: |
|---|
| 136 | c ---------------- |
|---|
| 137 | |
|---|
| 138 | CSUBP = RCPD*1e4 ! HEAT CAPACITY OF TITANS ATMOSPHERE in CGS |
|---|
| 139 | |
|---|
| 140 | UBARI2=1./1.66 |
|---|
| 141 | UBARI2=UBARI |
|---|
| 142 | |
|---|
| 143 | C ZERO THE NET FLUXES |
|---|
| 144 | Q0 = 0.0 |
|---|
| 145 | lwnet = 0.0 |
|---|
| 146 | |
|---|
| 147 | c----------------------------------------------------------------------- |
|---|
| 148 | C WE NOW ENTER A MAJOR LOOP OVER SPECRAL INTERVALS IN THE INFRARED |
|---|
| 149 | C TO CALCULATE THE NET FLUX IN EACH SPECTRAL INTERVAL |
|---|
| 150 | c----------------------------------------------------------------------- |
|---|
| 151 | |
|---|
| 152 | DO 2000 K=1,NSPECI ! *** START OF SPECTRAL LOOP |
|---|
| 153 | |
|---|
| 154 | c----------------------------------------------------------------------- |
|---|
| 155 | C SET UP ALTITIDUE PARAMETERS |
|---|
| 156 | |
|---|
| 157 | WAVEN=WNOI(K) |
|---|
| 158 | DW=DWNI(K) |
|---|
| 159 | zz1=DW/(2.*2) |
|---|
| 160 | EM = 0. |
|---|
| 161 | B0 = 0. |
|---|
| 162 | |
|---|
| 163 | DO J=1,NL-1 |
|---|
| 164 | DO ig=1,NG |
|---|
| 165 | TJ=TEMP(ig,J) |
|---|
| 166 | |
|---|
| 167 | |
|---|
| 168 | C Modif: in-lining de la fonction planck pour vectorisation |
|---|
| 169 | C B0(ig,J)=PLNCK(WAVEN,TJ,DW) |
|---|
| 170 | C FUNCTION PLNCK(WAV,T,DW) |
|---|
| 171 | C* PLNCK FUNCTION RETURNS B IN CGS UNITS, ERGS CM-2 WAVENUMBER-1 |
|---|
| 172 | C* WAVNUM IS WAVENUMBER IN CM-1 |
|---|
| 173 | C* T IS IN KELVIN |
|---|
| 174 | PLNCK=0. |
|---|
| 175 | DO I=-2,2,1 |
|---|
| 176 | WAVNUM=WAVEN + I*zz1 |
|---|
| 177 | zz2=EXP(-1.4388 * WAVNUM/TEMP(ig,J)) |
|---|
| 178 | zz3=WAVNUM*WAVNUM*WAVNUM |
|---|
| 179 | PLNCK=PLNCK+1.191E-5* zz3*zz2/(1.-zz2) |
|---|
| 180 | ENDDO |
|---|
| 181 | B0(ig,J)=.2*PLNCK |
|---|
| 182 | ENDDO |
|---|
| 183 | |
|---|
| 184 | IF (ICLD.EQ.1) THEN |
|---|
| 185 | DO ig=1,NG |
|---|
| 186 | zz4=EXP(-DTAUI(ig,J,K)/UBARI2) |
|---|
| 187 | EM(ig,J)=zz4 |
|---|
| 188 | ENDDO |
|---|
| 189 | ELSE |
|---|
| 190 | DO ig=1,NG |
|---|
| 191 | zz4=EXP(-DTAUIP(ig,J,K)/UBARI2) |
|---|
| 192 | EM(ig,J)=zz4 |
|---|
| 193 | ENDDO |
|---|
| 194 | ENDIF |
|---|
| 195 | ENDDO |
|---|
| 196 | |
|---|
| 197 | c----------------------------------------------------------------------- |
|---|
| 198 | C CALCULATE THE DOWNWELLING RADIATION AT THE TOP OF THE MODEL |
|---|
| 199 | C OR THE TOP LAYER WILL COOL TO SPACE UNPHYSICALLY |
|---|
| 200 | |
|---|
| 201 | FDI =0. |
|---|
| 202 | FDIS =0. |
|---|
| 203 | FUPI =0. |
|---|
| 204 | FUPIS=0. |
|---|
| 205 | |
|---|
| 206 | DO 2220 J=1,NL-1 |
|---|
| 207 | DO 2230 ig=1,NG |
|---|
| 208 | FDI(ig,J+1) = FDI(ig,J)*EM(ig,J) + 2.*RPI*UBARI* |
|---|
| 209 | & B0(ig,J)*(1.-EM(ig,J)) |
|---|
| 210 | FDIS(ig,J+1,K) = FDIS(ig,J,K)*EM(ig,J) + 2.*RPI*UBARI* |
|---|
| 211 | & B0(ig,J)*(1.-EM(ig,J)) |
|---|
| 212 | 2230 CONTINUE |
|---|
| 213 | 2220 CONTINUE |
|---|
| 214 | c write(*,*) |
|---|
| 215 | c write(*,*) 'cooling : EM =' , |
|---|
| 216 | c & ((EM(i,l),l=1,nl),i=1,ngrid) |
|---|
| 217 | c write(*,*) |
|---|
| 218 | c write(*,*) 'cooling : B0 =' , |
|---|
| 219 | c & ((B0(i,l),l=1,nl),i=1,ngrid) |
|---|
| 220 | c write(*,*) |
|---|
| 221 | c write(*,*) 'cooling : FDI =' , |
|---|
| 222 | c & ((FDI(i,l),l=1,nl),i=1,ngrid) |
|---|
| 223 | |
|---|
| 224 | c----------------------------------------------------------------------- |
|---|
| 225 | C UPWARD FLUXES: SURFACE EMISSIONS |
|---|
| 226 | |
|---|
| 227 | DO 2310 ig=1,NG |
|---|
| 228 | PLNCK=0. |
|---|
| 229 | DO I=-2,2,1 |
|---|
| 230 | WAVNUM=WAVEN + I*zz1 |
|---|
| 231 | zz2=EXP(-1.4388 * WAVNUM/TEMP(ig,NL)) |
|---|
| 232 | zz3=WAVNUM*WAVNUM*WAVNUM |
|---|
| 233 | PLNCK=PLNCK+1.191E-5* zz3*zz2/(1.-zz2) |
|---|
| 234 | ENDDO |
|---|
| 235 | c BSURF=PLNCK( WAVEN, TEMP(ig,NL), DW) |
|---|
| 236 | BSURF=.2*PLNCK |
|---|
| 237 | FUPI(ig,NL)=BSURF * 2.*RPI*UBARI + RSFI*FDI(ig,NL) |
|---|
| 238 | FUPIS(ig,NL,K)=BSURF*2.*RPI*UBARI+RSFI*FDIS(ig,NL,K) |
|---|
| 239 | 2310 CONTINUE |
|---|
| 240 | c write(*,*) |
|---|
| 241 | c write(*,*) 'cooling : FUPI/NL =' , |
|---|
| 242 | c & ((FUPI(i,l),l=nl,nl),i=1,NG) |
|---|
| 243 | c write(*,*) |
|---|
| 244 | c write(*,*) 'cooling : FDI/NL =' , |
|---|
| 245 | c & ((FDI(i,l),l=nl,nl),i=1,NG) |
|---|
| 246 | |
|---|
| 247 | DO 2320 J=NL-1,1,-1 |
|---|
| 248 | DO 2330 ig=1,NG |
|---|
| 249 | FUPI(ig,J) = FUPI(ig,J+1)*EM(ig,J) + 2.*RPI*UBARI* |
|---|
| 250 | & B0(ig,J)*(1.-EM(ig,J)) |
|---|
| 251 | FUPIS(ig,J,K) = FUPIS(ig,J+1,K)*EM(ig,J)+2.*RPI*UBARI* |
|---|
| 252 | & B0(ig,J)*(1.-EM(ig,J)) |
|---|
| 253 | 2330 CONTINUE |
|---|
| 254 | 2320 CONTINUE |
|---|
| 255 | c write(*,*) |
|---|
| 256 | c write(*,*) 'cooling : EM =' , |
|---|
| 257 | c & ((EM(i,l),l=1,nl),i=1,ngrid) |
|---|
| 258 | c write(*,*) |
|---|
| 259 | c write(*,*) 'cooling : B0 =' , |
|---|
| 260 | c & ((B0(i,l),l=1,nl),i=1,ngrid) |
|---|
| 261 | c write(*,*) |
|---|
| 262 | c write(*,*) 'cooling : FUPI =' , |
|---|
| 263 | c & ((FUPI(i,l),l=1,nl),i=1,ngrid) |
|---|
| 264 | |
|---|
| 265 | c compute the downward IR flux at the surface: |
|---|
| 266 | c |
|---|
| 267 | DO 3520 ig=1,NG |
|---|
| 268 | pfluxi(ig)=pfluxi(ig)+ DWNI(K)*FDI(ig,NL) |
|---|
| 269 | 3520 CONTINUE |
|---|
| 270 | |
|---|
| 271 | c compute the net IR flux, (+) upward: |
|---|
| 272 | c |
|---|
| 273 | DO J=1,NL |
|---|
| 274 | DO ig=1,NG |
|---|
| 275 | lwnet(ig,J)= lwnet(ig,J)+ DWNI(K)*(FUPI(ig,J)-FDI(ig,J)) |
|---|
| 276 | ENDDO |
|---|
| 277 | ENDDO |
|---|
| 278 | |
|---|
| 279 | DO 3210 J=1,NL-1 |
|---|
| 280 | DO 3220 ig=1,NG |
|---|
| 281 | QOUT=FUPI(ig,J) + FDI(ig,J+1) ! OUT OF LAYER |
|---|
| 282 | QIN =FDI(ig,J) + FUPI(ig,J+1) ! INTO LAYER |
|---|
| 283 | Q0(ig,J)=Q0(ig,J)+(QOUT-QIN)*DWNI(K) |
|---|
| 284 | 3220 CONTINUE |
|---|
| 285 | 3210 CONTINUE |
|---|
| 286 | |
|---|
| 287 | c write(*,*) |
|---|
| 288 | c write(*,*) 'cooling/loop : FUPI =' , |
|---|
| 289 | c & ((FUPI(i,l),l=1,nl),i=1,ngrid) |
|---|
| 290 | c write(*,*) |
|---|
| 291 | c write(*,*) 'cooling : FDI =' , |
|---|
| 292 | c & ((FDI(i,l),l=1,nl),i=1,ngrid) |
|---|
| 293 | c write(*,*) |
|---|
| 294 | c write(*,*) 'cooling : Q0 =' , |
|---|
| 295 | c & ((Q0(i,l),l=1,nl-1),i=1,ngrid) |
|---|
| 296 | |
|---|
| 297 | |
|---|
| 298 | c----------------------------------------------------------------------- |
|---|
| 299 | |
|---|
| 300 | 2000 CONTINUE ! *** END SPECTRAL INTERVAL COMPUTATIONS |
|---|
| 301 | |
|---|
| 302 | |
|---|
| 303 | c----------------------------------------------------------------------- |
|---|
| 304 | |
|---|
| 305 | c convertion erg/cm2 -> J/m2 |
|---|
| 306 | DO 3550 ig=1,NG |
|---|
| 307 | pfluxi(ig) = 1.e-3*pfluxi(ig) |
|---|
| 308 | lwnet(ig,:) = 1.e-3*lwnet(ig,:) |
|---|
| 309 | 3550 CONTINUE |
|---|
| 310 | |
|---|
| 311 | c PRINT*,'flux IR' |
|---|
| 312 | c WRITE(*,'(8e10.2)') pfluxi |
|---|
| 313 | |
|---|
| 314 | C COMPUTE THE BASELINE COOLING RATE |
|---|
| 315 | |
|---|
| 316 | DO 3000 J=1,NL-1 |
|---|
| 317 | C TURN THE Q'S INTO TIMESCALES..... |
|---|
| 318 | DO 3300 ig=1,NG |
|---|
| 319 | eff_g = RG*(RA/(RA+Z(ig,J)))**2 ! 10% DIFF AT 1 MBAR |
|---|
| 320 | COLDEN = RHOP*(PRESS(ig,J+1)-PRESS(ig,J))/eff_g |
|---|
| 321 | c Q0(J) = (COLDEN * CSUBP )/Q0(J) |
|---|
| 322 | Q0(ig,J) = Q0(ig,J) / (COLDEN*CSUBP) |
|---|
| 323 | 3300 CONTINUE |
|---|
| 324 | 3000 CONTINUE |
|---|
| 325 | |
|---|
| 326 | c write(*,*) |
|---|
| 327 | c write(*,*) 'cooling/end : Q0 =' |
|---|
| 328 | c write(*,*) ((Q0(k,l)*1e7,l=1,nl-1),k=1,ngrid) |
|---|
| 329 | c----------------------------------------------------------------------- |
|---|
| 330 | |
|---|
| 331 | RETURN |
|---|
| 332 | END |
|---|
