| 1 | MODULE lwmain_mod |
|---|
| 2 | |
|---|
| 3 | IMPLICIT NONE |
|---|
| 4 | |
|---|
| 5 | CONTAINS |
|---|
| 6 | |
|---|
| 7 | subroutine lwmain (ig0,icount,kdlon,kflev |
|---|
| 8 | . ,dp,dt0,emis |
|---|
| 9 | . ,plev,tlev,tlay,aerosol,coolrate |
|---|
| 10 | . ,fluxground,fluxtop |
|---|
| 11 | . ,netrad |
|---|
| 12 | & ,QIRsQREF3d,omegaIR3d,gIR3d |
|---|
| 13 | & ,co2ice) |
|---|
| 14 | |
|---|
| 15 | c---------------------------------------------------------------------- |
|---|
| 16 | c LWMAIN organizes the LTE longwave calculations |
|---|
| 17 | c for layer 1 to layer "nlaylte" (stored in "yomlw_h") |
|---|
| 18 | c---------------------------------------------------------------------- |
|---|
| 19 | |
|---|
| 20 | use dimradmars_mod, only: ndlo2, nflev, nir, ndlon, nuco2 |
|---|
| 21 | use dimradmars_mod, only: naerkind |
|---|
| 22 | use yomlw_h, only: nlaylte, xi |
|---|
| 23 | use lwi_mod, only: lwi |
|---|
| 24 | use lwflux_mod, only: lwflux |
|---|
| 25 | |
|---|
| 26 | implicit none |
|---|
| 27 | |
|---|
| 28 | c declarations |
|---|
| 29 | c ------------- |
|---|
| 30 | include "callkeys.h" |
|---|
| 31 | |
|---|
| 32 | c---------------------------------------------------------------------- |
|---|
| 33 | c 0.1 arguments |
|---|
| 34 | c --------- |
|---|
| 35 | c inputs/outputs: |
|---|
| 36 | c ------- |
|---|
| 37 | integer, intent(in) :: ig0 |
|---|
| 38 | integer, intent(in) :: icount |
|---|
| 39 | integer, intent(in) :: kdlon ! part of ngrid |
|---|
| 40 | integer, intent(in) :: kflev ! part of nlayer |
|---|
| 41 | |
|---|
| 42 | real, intent(in) :: dp (ndlo2,kflev) ! layer pressure thickness (Pa) |
|---|
| 43 | real, intent(in) :: dt0 (ndlo2) ! surface temperature discontinuity (K) |
|---|
| 44 | real, intent(in) :: emis (ndlo2) ! surface emissivity |
|---|
| 45 | real, intent(in) :: plev (ndlo2,kflev+1) ! level pressure (Pa) |
|---|
| 46 | real, intent(in) :: tlev (ndlo2,kflev+1) ! level temperature (K) |
|---|
| 47 | real, intent(in) :: tlay (ndlo2,kflev) ! layer temperature (K) |
|---|
| 48 | real, intent(in) :: aerosol(ndlo2,kflev,naerkind) ! aerosol extinction optical |
|---|
| 49 | c depth at reference wavelength "longrefvis" set |
|---|
| 50 | c in dimradmars_mod , in each layer, for one of |
|---|
| 51 | c the "naerkind" kind of aerosol optical properties. |
|---|
| 52 | |
|---|
| 53 | |
|---|
| 54 | c outputs: |
|---|
| 55 | c -------- |
|---|
| 56 | real, intent(out) :: coolrate(ndlo2,kflev) ! cooling rate (K/s) |
|---|
| 57 | real, intent(out) :: fluxground(ndlo2) ! downward ground flux (W/m2) |
|---|
| 58 | real, intent(out) :: fluxtop(ndlo2) ! outgoing upward flux (W/m2) ("OLR") |
|---|
| 59 | real, intent(out) :: netrad (ndlo2,kflev) ! radiative budget (W/m2) |
|---|
| 60 | c Aerosol optical properties |
|---|
| 61 | real, intent(in) :: QIRsQREF3d(ndlo2,kflev,nir,naerkind) |
|---|
| 62 | real, intent(in) :: omegaIR3d(ndlo2,kflev,nir,naerkind) |
|---|
| 63 | real, intent(in) :: gIR3d(ndlo2,kflev,nir,naerkind) |
|---|
| 64 | real, intent(in) :: co2ice(ndlo2) ! co2 ice surface layer (kg.m-2) |
|---|
| 65 | c---------------------------------------------------------------------- |
|---|
| 66 | c 0.2 local arrays |
|---|
| 67 | c ------------ |
|---|
| 68 | |
|---|
| 69 | real aer_t (ndlon,nuco2,nflev+1) ! transmission (aer) |
|---|
| 70 | real co2_u (ndlon,nuco2,nflev+1) ! absorber amounts (co2) |
|---|
| 71 | real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2) |
|---|
| 72 | |
|---|
| 73 | real bsurf (ndlon,nir) ! surface spectral planck function |
|---|
| 74 | real btop (ndlon,nir) ! top spectral planck function |
|---|
| 75 | real blev (ndlon,nir,nflev+1) ! level spectral planck function |
|---|
| 76 | real blay (ndlon,nir,nflev) ! layer spectral planck function |
|---|
| 77 | real dblay (ndlon,nir,nflev) ! layer gradient spectral planck function |
|---|
| 78 | real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck function |
|---|
| 79 | ! in sub layers |
|---|
| 80 | |
|---|
| 81 | real tautotal(ndlon,nflev,nir) ! \ Total single scattering |
|---|
| 82 | real omegtotal(ndlon,nflev,nir) ! > properties (Addition of the |
|---|
| 83 | real gtotal(ndlon,nflev,nir) ! / NAERKIND aerosols prop.) |
|---|
| 84 | |
|---|
| 85 | real newcoolrate(ndlon,nflev) ! cooling rate (K/s) / with implicite scheme |
|---|
| 86 | |
|---|
| 87 | real emis_gaz(ndlo2) ! emissivity for gaz computations |
|---|
| 88 | |
|---|
| 89 | integer jk,jkk,ja,jl |
|---|
| 90 | |
|---|
| 91 | |
|---|
| 92 | c---------------------------------------------------------------------- |
|---|
| 93 | c 0.3 Initialisation |
|---|
| 94 | c -------------- |
|---|
| 95 | |
|---|
| 96 | DO jl=1 , kdlon |
|---|
| 97 | IF(co2ice(jl) .GT. 20.e-3) THEN |
|---|
| 98 | emis_gaz(jl)=1. |
|---|
| 99 | ELSE |
|---|
| 100 | emis_gaz(jl)=emis(jl) |
|---|
| 101 | ENDIF |
|---|
| 102 | ENDDO |
|---|
| 103 | |
|---|
| 104 | c---------------------------------------------------------------------- |
|---|
| 105 | c 1.0 planck function |
|---|
| 106 | c --------------- |
|---|
| 107 | |
|---|
| 108 | call lwb ( kdlon, kflev, tlev, tlay, dt0 |
|---|
| 109 | . , bsurf, btop, blay, blev, dblay, dbsublay) |
|---|
| 110 | |
|---|
| 111 | c---------------------------------------------------------------------- |
|---|
| 112 | c 2.0 absorber amounts |
|---|
| 113 | c ---------------- |
|---|
| 114 | |
|---|
| 115 | call lwu ( kdlon, kflev |
|---|
| 116 | . , dp, plev, tlay, aerosol |
|---|
| 117 | & , QIRsQREF3d,omegaIR3d,gIR3d |
|---|
| 118 | . , aer_t, co2_u, co2_up |
|---|
| 119 | . , tautotal,omegtotal,gtotal) |
|---|
| 120 | |
|---|
| 121 | c---------------------------------------------------------------------- |
|---|
| 122 | c 3.0 transmission functions / exchange coefficiants |
|---|
| 123 | c ---------------------------------------------- |
|---|
| 124 | |
|---|
| 125 | c distants |
|---|
| 126 | c -------- |
|---|
| 127 | if( mod(icount-1,ilwd).eq.0) then |
|---|
| 128 | |
|---|
| 129 | c print*, 'CALL of DISTANTS' |
|---|
| 130 | call lwxd ( ig0, kdlon, kflev, emis_gaz |
|---|
| 131 | . , aer_t, co2_u, co2_up) |
|---|
| 132 | |
|---|
| 133 | endif |
|---|
| 134 | c neighbours |
|---|
| 135 | c ---------- |
|---|
| 136 | if( mod(icount-1,ilwn).eq.0) then |
|---|
| 137 | |
|---|
| 138 | c print*, 'CALL of NEIGHBOURS' |
|---|
| 139 | call lwxn ( ig0, kdlon, kflev |
|---|
| 140 | . , dp |
|---|
| 141 | . , aer_t, co2_u, co2_up) |
|---|
| 142 | |
|---|
| 143 | endif |
|---|
| 144 | c boundaries |
|---|
| 145 | c ---------- |
|---|
| 146 | if( mod(icount-1,ilwb).eq.0) then |
|---|
| 147 | |
|---|
| 148 | c print*, 'CALL of BOUNDARIES' |
|---|
| 149 | call lwxb ( ig0, kdlon, kflev, emis_gaz |
|---|
| 150 | . , aer_t, co2_u, co2_up) |
|---|
| 151 | |
|---|
| 152 | endif |
|---|
| 153 | |
|---|
| 154 | c---------------------------------------------------------------------- |
|---|
| 155 | c 4.0 cooling rate |
|---|
| 156 | c ------------ |
|---|
| 157 | |
|---|
| 158 | call lwflux ( ig0, kdlon, kflev, dp |
|---|
| 159 | . , bsurf, btop, blev, blay, dbsublay |
|---|
| 160 | . , tlay, tlev, dt0 ! pour sortie dans g2d uniquement |
|---|
| 161 | . , emis |
|---|
| 162 | . , tautotal,omegtotal,gtotal |
|---|
| 163 | . , coolrate, fluxground, fluxtop |
|---|
| 164 | . , netrad) |
|---|
| 165 | |
|---|
| 166 | c do jk = 1, nlaylte |
|---|
| 167 | c print*,coolrate(1,jk) |
|---|
| 168 | c enddo |
|---|
| 169 | |
|---|
| 170 | c do jkk = 0 , nlaylte+1 |
|---|
| 171 | c do jk = 0 , nlaylte+1 |
|---|
| 172 | c do ja = 1 , nuco2 |
|---|
| 173 | c do jl = 1 , ngrid |
|---|
| 174 | c if (xi (jl,ja,jk,jkk) .LT. 0 |
|---|
| 175 | c . .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then |
|---|
| 176 | c print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk) |
|---|
| 177 | c endif |
|---|
| 178 | c enddo |
|---|
| 179 | c enddo |
|---|
| 180 | c enddo |
|---|
| 181 | c enddo |
|---|
| 182 | |
|---|
| 183 | c---------------------------------------------------------------------- |
|---|
| 184 | c |
|---|
| 185 | c 5. shema semi-implicite (lwi) |
|---|
| 186 | c --------------------------- |
|---|
| 187 | c |
|---|
| 188 | c |
|---|
| 189 | call lwi (ig0,kdlon,kflev,netrad,dblay,dp |
|---|
| 190 | . , newcoolrate) |
|---|
| 191 | c |
|---|
| 192 | c Verif que (X sol,space) + somme(X i,sol) = 1 |
|---|
| 193 | c |
|---|
| 194 | do jkk = 1 , nlaylte |
|---|
| 195 | do jl = 1 , kdlon |
|---|
| 196 | c print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk) |
|---|
| 197 | c . ,coolrate(jl,jkk) |
|---|
| 198 | coolrate(jl,jkk) = newcoolrate(jl,jkk) |
|---|
| 199 | enddo |
|---|
| 200 | enddo |
|---|
| 201 | c |
|---|
| 202 | c---------------------------------------------------------------------- |
|---|
| 203 | |
|---|
| 204 | END SUBROUTINE lwmain |
|---|
| 205 | |
|---|
| 206 | END MODULE lwmain_mod |
|---|
| 207 | |
|---|
