Changeset 4077 for trunk/LMDZ.GENERIC/libf
- Timestamp:
- Feb 18, 2026, 10:28:23 AM (6 weeks ago)
- Location:
- trunk/LMDZ.GENERIC/libf/phygeneric
- Files:
-
- 1 deleted
- 13 edited
- 29 moved
-
aerosol_global_variables.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_mod.F90) (5 diffs)
-
aerosol_opacity.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/aeropacity.F90) (9 diffs)
-
aerosol_optical_properties.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/aeroptproperties.F90) (4 diffs)
-
aerosol_optical_properties_averaging.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/aerave_new.F) (4 diffs)
-
aerosol_radius.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/radii_mod.F90) (12 diffs)
-
callsedim.F (modified) (1 diff)
-
condense_co2.F90 (modified) (2 diffs)
-
dyn1d/kcm1d.F90 (modified) (4 diffs)
-
dyn1d/rcm1d.F (modified) (1 diff)
-
ephemeris_orbit.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/orbite.F) (1 diff)
-
ephemeris_orbit_init.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/iniorbit.F) (5 diffs)
-
ephemeris_stellar_angle.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/stelang.F) (2 diffs)
-
ephemeris_stellar_longitude.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/stellarlong.F) (1 diff)
-
inifis_mod.F90 (modified) (3 diffs)
-
initracer.F90 (modified) (2 diffs)
-
newsedim.F (modified) (1 diff)
-
physiq_mod.F90 (modified) (17 diffs)
-
rad_blackbody.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/blackl.F) (2 diffs)
-
rad_correlatedk.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/callcorrk.F90) (26 diffs)
-
rad_correlatedk_continuum_interpolation.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/interpolate_continuum.F90) (7 diffs)
-
rad_correlatedk_fluxes_solver_stellar.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/gfluxv.F) (5 diffs)
-
rad_correlatedk_fluxes_solver_thermal.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/gfluxi.F) (7 diffs)
-
rad_correlatedk_fluxes_stellar.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/sfluxv.F) (6 diffs)
-
rad_correlatedk_fluxes_thermal.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/sfluxi.F) (6 diffs)
-
rad_correlatedk_ini_aerosol.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/suaer_corrk.F90) (13 diffs)
-
rad_correlatedk_init_stellar.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/setspv.F90) (9 diffs)
-
rad_correlatedk_init_thermal.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/setspi.F90) (10 diffs)
-
rad_correlatedk_online_recombination.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/recombin_corrk_mod.F90) (17 diffs)
-
rad_correlatedk_opacities_stellar.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/optcv.F90) (10 diffs)
-
rad_correlatedk_opacities_thermal.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/optci.F90) (7 diffs)
-
rad_correlatedk_rayleigh_scattering_opacity.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/calc_rayleigh.F90) (6 diffs)
-
rad_correlatedk_read_opacity_tables.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/sugas_corrk.F90) (21 diffs)
-
rad_correlatedk_stellar_spectrum.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/ave_stelspec.F90) (7 diffs)
-
rad_newton_cooling.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/newtrelax.F90) (2 diffs)
-
rad_newton_cooling_hot_jupiter.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/newton_cooling_hotJ.F90) (6 diffs)
-
rad_ring_shadowing.F90 (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/call_rings.F90) (5 diffs)
-
rad_tridiagonal_matrix_solver.F (moved) (moved from trunk/LMDZ.GENERIC/libf/phygeneric/dsolver.F) (1 diff)
-
radcommon_h.F90 (modified) (5 diffs)
-
radinc_h.F90 (modified) (1 diff)
-
rain.F90 (modified) (1 diff)
-
rain_generic.F90 (modified) (1 diff)
-
rings.F90 (deleted)
-
su_gases.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_global_variables.F90
r4076 r4077 1 1 !================================================================== 2 module aerosol_ mod2 module aerosol_global_variables 3 3 implicit none 4 4 … … 7 7 ! aerosol indexes: these are initialized to be 0 if the 8 8 ! corresponding aerosol was not activated in callphys.def 9 ! -- otherwise a value is set via iniaerosol9 ! -- otherwise a value is set via aerosol_init 10 10 integer, save, protected :: iaero_co2 = 0 11 11 integer, save, protected :: iaero_h2o = 0 … … 43 43 contains 44 44 45 SUBROUTINE iniaerosol45 SUBROUTINE aerosol_init 46 46 47 47 use mod_phys_lmdz_para, only : is_master … … 181 181 182 182 ! For the zero aerosol case, we currently make a dummy co2 aerosol which is zero everywhere. 183 ! (See aero pacity.F90 for how this works). A better solution would be to turn off the183 ! (See aerosol_opacity.F90 for how this works). A better solution would be to turn off the 184 184 ! aerosol machinery in the no aerosol case, but this would be complicated. LK 185 185 … … 197 197 print*, 'according to current options in callphys.def' 198 198 print*, 'or change/correct incompatible options there' 199 print*, 'Abort in iniaerosol'199 print*, 'Abort in aerosol_init' 200 200 endif 201 201 call abort_physic("iniaerosl",'wrong number of aerosols',1) 202 202 endif ! of if (ia.ne.naerkind) 203 203 204 END SUBROUTINE iniaerosol205 206 end module aerosol_ mod207 !================================================================== 204 END SUBROUTINE aerosol_init 205 206 end module aerosol_global_variables 207 !================================================================== -
trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_opacity.F90
r4076 r4077 1 module aero pacity_mod1 module aerosol_opacity_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 Subroutine aero pacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,zls, &7 Subroutine aerosol_opacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,zls, & 8 8 aerosol,reffrad,nueffrad, QREFvis3d,QREFir3d,tau_col, & 9 9 cloudfrac,totcloudfrac,clearsky) 10 10 11 11 use radinc_h, only : L_TAUMAX,naerkind 12 use aerosol_ mod, only: iaero_nlay, iaero_generic, &12 use aerosol_global_variables , only: iaero_nlay, iaero_generic, & 13 13 iaero_aurora, iaero_back2lay, iaero_co2, & 14 14 iaero_dust, iaero_h2o, iaero_h2so4, & … … 120 120 IF (firstcall) THEN 121 121 ia =0 122 write(*,*) "Tracers found in aero pacity:"122 write(*,*) "Tracers found in aerosol_opacity:" 123 123 do iq=1,nq 124 124 tracername=noms(iq) … … 135 135 136 136 if (noaero) then 137 print*, "No active aerosols found in aero pacity"137 print*, "No active aerosols found in aerosol_opacity" 138 138 else 139 139 print*, "If you would like to use aerosols, make sure any old" 140 140 print*, "start files are updated in newstart using the option" 141 141 print*, "q=0" 142 write(*,*) "Active aerosols found in aero pacity:"142 write(*,*) "Active aerosols found in aerosol_opacity:" 143 143 endif 144 144 … … 269 269 end do 270 270 271 call abort_physic("aero pacity", "Something wrong happened on water ice liquid opacity calculation",1)271 call abort_physic("aerosol_opacity", "Something wrong happened on water ice liquid opacity calculation",1) 272 272 endif 273 273 … … 276 276 do ig=1, ngrid 277 277 !do l=1,nlayer-1 ! to stop the rad tran bug 278 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see optcv)278 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see rad_correlatedk_opacities_stellar) 279 279 ! same correction should b-probably be done for other aerosol types. 280 280 aerosol(ig,l,iaer) = & !modification by BC … … 294 294 do ig=1, ngrid 295 295 !do l=1,nlayer-1 ! to stop the rad tran bug 296 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see optcv)296 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see rad_correlatedk_opacities_stellar) 297 297 CLFtot = max(totcloudfrac(ig),0.01) 298 298 aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot … … 303 303 do ig=1, ngrid 304 304 !do l=1,nlayer-1 ! to stop the rad tran bug 305 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see optcv)305 do l=1,nlayer !JL18 if aerosols are present in the last layer we must account for them. Provides better upper boundary condition in the IR. They must however be put to zero in the sw (see rad_correlatedk_opacities_stellar) 306 306 CLFtot = CLFfixval 307 307 aerosol(ig,l,iaer)=aerosol(ig,l,iaer)/CLFtot … … 1092 1092 ! end do 1093 1093 1094 end subroutine aero pacity1094 end subroutine aerosol_opacity 1095 1095 1096 end module aero pacity_mod1096 end module aerosol_opacity_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_optical_properties.F90
r4076 r4077 1 module aero ptproperties_mod1 module aerosol_optical_properties_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 SUBROUTINE aeroptproperties(ngrid,nlayer,reffrad,nueffrad, & 7 SUBROUTINE aerosol_optical_properties(ngrid,nlayer,reffrad, & 8 nueffrad, & 8 9 QVISsQREF3d,omegaVIS3d,gVIS3d, & 9 10 QIRsQREF3d,omegaIR3d,gIR3d, & 10 11 QREFvis3d,QREFir3d)!, & 11 ! omegaREFvis3d,omegaREFir3d)12 ! omegaREFvis3d,omegaREFir3d) 12 13 13 14 use radinc_h, only: L_NSPECTI,L_NSPECTV,nsizemax,naerkind … … 310 311 ! 1.3 Effective variance 311 312 if(nuefftabsize.eq.1)then ! addded by RDW 312 print*,'Warning: no variance range in aero ptproperties'313 print*,'Warning: no variance range in aerosol_optical_properties' 313 314 nuefftab(1)=0.2 314 315 else … … 814 815 ENDDO ! iaer (loop on aerosol kind) 815 816 816 END SUBROUTINE aero ptproperties817 818 819 end module aero ptproperties_mod817 END SUBROUTINE aerosol_optical_properties 818 819 820 end module aerosol_optical_properties_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_optical_properties_averaging.F
r4076 r4077 1 SUBROUTINE aer ave_new (ndata,1 SUBROUTINE aerosol_optical_properties_averaging(ndata, 2 2 & longdata,epdata,omegdata,gdata, 3 & longref,epref,temp,nir,longir4 & ,epir,omegir,gir,qref,omegaref)3 & longref,epref,temp,nir,longir, 4 & epir,omegir,gir,qref,omegaref) 5 5 6 6 … … 87 87 IF (longdata(1).LT.longdata(ndata)) THEN 88 88 IF (.not.(longdata(idata).LT.longdata(idata+1))) THEN 89 call abort_physic("aer ave_new",89 call abort_physic("aerosol_optical_properties_averaging", 90 90 & "Non descending order in longdata",1) 91 91 ENDIF 92 92 ELSEIF (longdata(1).GT.longdata(ndata)) THEN 93 93 IF (.not.(longdata(idata).GT.longdata(idata+1))) THEN 94 call abort_physic("aer ave_new",94 call abort_physic("aerosol_optical_properties_averaging", 95 95 & "Non ascending order in longdata",1) 96 96 ENDIF … … 174 174 c 175 175 long=longir(iir) + (ibande-0.5E+0) * deltalong 176 CALL blackl(DBLE(long),DBLE(temp),tmp1) 176 CALL rad_blackbody_planck_law_wavelength(DBLE(long), 177 & DBLE(temp),tmp1) 177 178 emit=REAL(tmp1) 178 179 c … … 240 241 c 241 242 long=longir(iir) + (ibande-0.5E+0) * deltalong 242 CALL blackl(DBLE(long),DBLE(temp),tmp1) 243 CALL rad_blackbody_planck_law_wavelength(DBLE(long) 244 & ,DBLE(temp),tmp1) 243 245 emit=REAL(tmp1) 244 246 c -
trunk/LMDZ.GENERIC/libf/phygeneric/aerosol_radius.F90
r4076 r4077 1 1 !================================================================== 2 module radii_mod2 module aerosol_radius 3 3 !================================================================== 4 4 ! module to centralize the radii calculations for aerosols … … 13 13 !$OMP THREADPRIVATE(radfixed) 14 14 15 ! water cloud optical properties (initialized in su_aer_radiibelow)15 ! water cloud optical properties (initialized in aerosol_radius_init below) 16 16 real, save :: rad_h2o 17 17 real, save :: rad_h2o_ice … … 21 21 22 22 real,save :: nueff_iaero_h2o ! effective variance of H2O aerosol 23 ! (initialized in su_aer_radiibelow)23 ! (initialized in aerosol_radius_init below) 24 24 !$OMP THREADPRIVATE(nueff_iaero_h2o) 25 25 ! coefficients for a variable nueff() for h2o aerosol; disabled for now … … 32 32 33 33 !================================================================== 34 subroutine su_aer_radii(ngrid,nlayer,reffrad,nueffrad)34 subroutine aerosol_radius_init(ngrid,nlayer,reffrad,nueffrad) 35 35 !================================================================== 36 36 ! Purpose … … 50 50 use ioipsl_getin_p_mod, only: getin_p 51 51 use radinc_h, only: naerkind 52 use aerosol_ mod, only: iaero_back2lay, iaero_co2, iaero_dust, &52 use aerosol_global_variables , only: iaero_back2lay, iaero_co2, iaero_dust, & 53 53 iaero_h2o, iaero_h2so4, iaero_nh3, iaero_nlay, & 54 54 iaero_aurora, iaero_generic, i_rgcs_ice, & … … 185 185 186 186 187 end subroutine su_aer_radii187 end subroutine aerosol_radius_init 188 188 !================================================================== 189 189 … … 243 243 244 244 ! For now only constant nueff is enabled (otherwise some specific handling 245 ! of variable nueff is required in aero ptproperties)245 ! of variable nueff is required in aerosol_optical_properties) 246 246 nueffrad(1:ngrid,1:nlayer)=nueff_iaero_h2o 247 247 … … 296 296 297 297 !================================================================== 298 subroutine co2_reffrad(ngrid,nlayer,nq,pq,reffrad)298 subroutine aerosol_radius_co2(ngrid,nlayer,nq,pq,reffrad) 299 299 !================================================================== 300 300 ! Purpose … … 333 333 end if 334 334 335 end subroutine co2_reffrad336 !================================================================== 337 338 339 340 !================================================================== 341 subroutine dust_reffrad(ngrid,nlayer,reffrad)335 end subroutine aerosol_radius_co2 336 !================================================================== 337 338 339 340 !================================================================== 341 subroutine aerosol_radius_dust(ngrid,nlayer,reffrad) 342 342 !================================================================== 343 343 ! Purpose … … 359 359 reffrad(1:ngrid,1:nlayer) = 2.e-6 ! dust 360 360 361 end subroutine dust_reffrad362 !================================================================== 363 364 365 !================================================================== 366 subroutine h2so4_reffrad(ngrid,nlayer,reffrad)361 end subroutine aerosol_radius_dust 362 !================================================================== 363 364 365 !================================================================== 366 subroutine aerosol_radius_h2so4(ngrid,nlayer,reffrad) 367 367 !================================================================== 368 368 ! Purpose … … 384 384 reffrad(1:ngrid,1:nlayer) = 1.e-6 ! h2so4 385 385 386 end subroutine h2so4_reffrad387 !================================================================== 388 389 !================================================================== 390 subroutine back2lay_reffrad(ngrid,reffrad,nlayer,pplev)386 end subroutine aerosol_radius_h2so4 387 !================================================================== 388 389 !================================================================== 390 subroutine aerosol_radius_back2lay(ngrid,reffrad,nlayer,pplev) 391 391 !================================================================== 392 392 ! Purpose … … 426 426 ENDDO 427 427 428 end subroutine back2lay_reffrad429 !================================================================== 430 431 end module radii_mod432 !================================================================== 428 end subroutine aerosol_radius_back2lay 429 !================================================================== 430 431 end module aerosol_radius 432 !================================================================== -
trunk/LMDZ.GENERIC/libf/phygeneric/callsedim.F
r3893 r4077 10 10 11 11 use radinc_h, only : naerkind 12 use radii_mod, only: h2o_reffrad13 use aerosol_ mod, only : iaero_h2o12 use aerosol_radius, only: h2o_reffrad 13 use aerosol_global_variables , only : iaero_h2o 14 14 USE tracer_h, only : igcm_co2_ice,igcm_h2o_ice,radius,rho_q 15 15 use comcstfi_mod, only: g -
trunk/LMDZ.GENERIC/libf/phygeneric/condense_co2.F90
r3893 r4077 8 8 use radinc_h, only : L_NSPECTV 9 9 use gases_h, only: gfrac, igas_co2 10 use radii_mod, only : co2_reffrad11 use aerosol_ mod, only : iaero_co210 use aerosol_radius, only : aerosol_radius_co2 11 use aerosol_global_variables , only : iaero_co2 12 12 USE surfdat_h, only: emisice, emissiv 13 13 USE geometry_mod, only: latitude ! in radians … … 273 273 ! Gravitational sedimentation starts. 274 274 275 ! Sedimentation computed from radius computed from q in module radii_mod.276 call co2_reffrad(ngrid,nlayer,nq,zq,reffrad)275 ! Sedimentation computed from radius computed from q in module aerosol_radius. 276 call aerosol_radius_co2(ngrid,nlayer,nq,zq,reffrad) 277 277 278 278 DO ilay=1,nlayer -
trunk/LMDZ.GENERIC/libf/phygeneric/dyn1d/kcm1d.F90
r3893 r4077 11 11 varspec, varspec_data, nvarlayer 12 12 use inifis_mod, only: inifis 13 use aerosol_ mod, only: iniaerosol14 use callcorrk_mod, only: callcorrk13 use aerosol_global_variables , only: aerosol_init 14 use rad_correlatedk_mod, only: rad_correlatedk 15 15 use comcstfi_mod 16 16 use mod_grid_phy_lmdz, only : regular_lonlat … … 410 410 411 411 412 call iniaerosol412 call aerosol_init 413 413 414 414 … … 416 416 417 417 ! Run radiative transfer 418 call callcorrk(1,nlayer,q,nq,qsurf, &418 call rad_correlatedk(1,nlayer,q,nq,qsurf, & 419 419 albedo_wv,albedo_equivalent, & 420 420 emis,mu0,plev,play,temp, & … … 470 470 firstcall=.false. 471 471 lastcall=.true. 472 call callcorrk(1,nlayer,q,nq,qsurf, &472 call rad_correlatedk(1,nlayer,q,nq,qsurf, & 473 473 albedo_wv,albedo_equivalent,emis,mu0,plev,play,temp, & 474 474 tsurf,fract,dist_star,aerosol,muvar, & -
trunk/LMDZ.GENERIC/libf/phygeneric/dyn1d/rcm1d.F
r3995 r4077 1161 1161 IF (idt.eq.ndt) then !test 1162 1162 lastcall=.true. 1163 call stellarlong(day*1.0,zls)1163 call ephemeris_stellar_longitude(day*1.0,zls) 1164 1164 ! write(103,*) 'Ls=',zls*180./pi 1165 1165 ! write(103,*) 'Lat=', latitude(1)*180./pi -
trunk/LMDZ.GENERIC/libf/phygeneric/ephemeris_orbit.F
r4076 r4077 1 subroutine orbite(pls,pdist_star,pdecli,pright_ascenc)1 subroutine ephemeris_orbit(pls,pdist_star,pdecli,pright_ascenc) 2 2 3 3 use planete_mod, only: p_elips, e_elips, timeperi, obliquit -
trunk/LMDZ.GENERIC/libf/phygeneric/ephemeris_orbit_init.F
r4076 r4077 1 SUBROUTINE iniorbit1 SUBROUTINE ephemeris_orbit_init 2 2 $ (papoastr,pperiastr,pyear_day,pperi_day,pobliq) 3 3 … … 32 32 peri_day=pperi_day 33 33 34 PRINT*,' iniorbit: Periastron in AU ',periastr35 PRINT*,' iniorbit: Apoastron in AU ',apoastr36 PRINT*,' iniorbit: Obliquity in degrees :',obliquit34 PRINT*,'ephemeris_orbit_init: Periastron in AU ',periastr 35 PRINT*,'ephemeris_orbit_init: Apoastron in AU ',apoastr 36 PRINT*,'ephemeris_orbit_init: Obliquity in degrees :',obliquit 37 37 38 38 … … 40 40 p_elips=0.5*(periastr+apoastr)*(1-e_elips*e_elips) 41 41 42 print*,' iniorbit: e_elips',e_elips43 print*,' iniorbit: p_elips',p_elips42 print*,'ephemeris_orbit_init: e_elips',e_elips 43 print*,'ephemeris_orbit_init: p_elips',p_elips 44 44 45 45 !----------------------------------------------------------------------- … … 52 52 zanom=2.*pi*(zz-nint(zz)) 53 53 zxref=abs(zanom) 54 PRINT*,' iniorbit: zanom ',zanom54 PRINT*,'ephemeris_orbit_init: zanom ',zanom 55 55 56 56 ! solve equation zx0 - e * sin (zx0) = zxref for eccentric anomaly zx0 … … 66 66 zx0=zx0+zdx 67 67 if(zanom.lt.0.) zx0=-zx0 68 PRINT*,' iniorbit: zx0 ',zx068 PRINT*,'ephemeris_orbit_init: zx0 ',zx0 69 69 70 70 timeperi=2.*atan(sqrt((1.+e_elips)/(1.-e_elips))*tan(zx0/2.)) 71 PRINT*,' iniorbit: Perihelion solar long. Ls (deg)=',71 PRINT*,'ephemeris_orbit_init: Perihelion solar long. Ls (deg)=', 72 72 & 360.-timeperi*180./pi 73 73 -
trunk/LMDZ.GENERIC/libf/phygeneric/ephemeris_stellar_angle.F
r4076 r4077 1 subroutine stelang(kgrid,psilon,pcolon,psilat,pcolat, 1 subroutine ephemeris_stellar_angle(kgrid, 2 & psilon,pcolon,psilat,pcolat, 2 3 & ptim1,ptim2,ptim3,pmu0,pfract, pflat) 3 4 IMPLICIT NONE … … 12 13 C** INTERFACE. 13 14 C ---------- 14 C SUBROUTINE STELANG( KGRID )15 C SUBROUTINE ephemeris_stellar_angle ( KGRID ) 15 16 C 16 17 C EXPLICIT ARGUMENTS : -
trunk/LMDZ.GENERIC/libf/phygeneric/ephemeris_stellar_longitude.F
r4076 r4077 1 SUBROUTINE stellarlong(pday,pstellong)1 SUBROUTINE ephemeris_stellar_longitude(pday,pstellong) 2 2 3 3 USE planete_mod, ONLY: year_day, peri_day, e_elips, timeperi -
trunk/LMDZ.GENERIC/libf/phygeneric/inifis_mod.F90
r4055 r4077 12 12 use radinc_h, only: ini_radinc_h, naerkind 13 13 use radcommon_h, only: ini_radcommon_h 14 use radii_mod, only: radfixed, Nmix_co214 use aerosol_radius, only: radfixed, Nmix_co2 15 15 use datafile_mod, only: datadir 16 16 use comdiurn_h, only: sinlat, coslat, sinlon, coslon … … 27 27 use ioipsl_getin_p_mod, only : getin_p 28 28 use mod_phys_lmdz_para, only : is_parallel, is_master, bcast 29 use newton_cooling_hotJ, only: planetary_suffix29 use rad_netwon_cooling_hot_jupiter, only: planetary_suffix 30 30 31 31 !======================================================================= … … 80 80 CHARACTER(len=20) :: rname="inifis" ! routine name, for messages 81 81 82 EXTERNAL iniorbit,orbite82 EXTERNAL ephemeris_orbit_init,ephemeris_orbit 83 83 EXTERNAL SSUM 84 84 REAL SSUM -
trunk/LMDZ.GENERIC/libf/phygeneric/initracer.F90
r3893 r4077 4 4 USE tracer_h 5 5 USE callkeys_mod, only: water 6 USE r ecombin_corrk_mod, ONLY: ini_recombin6 USE rad_correlatedk_online_recombination_mod, ONLY: rad_correlatedk_recombination_init 7 7 USE mod_phys_lmdz_para, only: is_master, bcast 8 8 use generic_cloud_common_h … … 503 503 ! Processing modern traceur options 504 504 if(moderntracdef) then 505 call ini_recombin505 call rad_correlatedk_recombination_init 506 506 endif 507 507 -
trunk/LMDZ.GENERIC/libf/phygeneric/newsedim.F
r3663 r4077 15 15 use tracer_h, only : igcm_h2o_ice 16 16 use watercommon_h, only: T_h2O_ice_liq,T_h2O_ice_clouds 17 use radii_mod, only: h2o_cloudrad17 use aerosol_radius, only: h2o_cloudrad 18 18 19 19 IMPLICIT NONE -
trunk/LMDZ.GENERIC/libf/phygeneric/physiq_mod.F90
r4033 r4077 23 23 use gases_h, only: gnom, gfrac, ngasmx 24 24 use radcommon_h, only: sigma, glat, grav, BWNV, WNOI, DWNI, DWNV, WNOV 25 use suaer_corrk_mod, only: suaer_corrk26 use setspv_mod, only: setspv27 use radii_mod, only: h2o_reffrad, co2_reffrad28 use aerosol_ mod, only: iniaerosol, iaero_co2, iaero_h2o25 use rad_correlatedk_ini_aerosol_mod, only: rad_correlatedk_ini_aerosol 26 use rad_correlatedk_init_stellar_mod, only: rad_correlatedk_init_stellar 27 use aerosol_radius, only: h2o_reffrad, aerosol_radius_co2 28 use aerosol_global_variables , only: aerosol_init, iaero_co2, iaero_h2o 29 29 use surfdat_h, only: phisfi, zmea, zstd, zsig, zgam, zthe, & 30 30 dryness … … 82 82 use conc_mod, only: rnew, cpnew, ini_conc_mod 83 83 use phys_state_var_mod 84 use callcorrk_mod, only: callcorrk84 use rad_correlatedk_mod, only: rad_correlatedk 85 85 use conduction_mod, only: conduction 86 86 use molvis_mod, only: molvis … … 95 95 use condensation_generic_mod, only: condensation_generic 96 96 use datafile_mod, only: datadir 97 use newton_cooling_hotJ, only: newtcool_MOCHA! LT, adding for MOCHA protocol97 use rad_netwon_cooling_hot_jupiter, only: rad_newton_cooling_MOCHA_intercomparison ! LT, adding for MOCHA protocol 98 98 99 99 #ifndef MESOSCALE … … 337 337 real dtmoist(ngrid,nlayer) ! Moistadj routine. 338 338 real dt_ekman(ngrid,nslay), dt_hdiff(ngrid,nslay), dt_gm(ngrid,nslay) ! Slab_ocean routine. 339 real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer) ! Callcorrk routine.339 real zdtsw1(ngrid,nlayer), zdtlw1(ngrid,nlayer) ! rad_correlatedk routine. 340 340 real zdtchim(ngrid,nlayer) ! Calchim routine. 341 341 … … 594 594 ! Initialize aerosol indexes. 595 595 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~ 596 call iniaerosol596 call aerosol_init 597 597 ! allocate related local arrays 598 598 ! (need be allocated instead of automatic because of "naerkind") … … 650 650 ! Initialize orbital calculation. 651 651 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 652 call iniorbit(apoastr,periastr,year_day,peri_day,obliquit)652 call ephemeris_orbit_init(apoastr,periastr,year_day,peri_day,obliquit) 653 653 654 654 … … 799 799 800 800 call su_watercycle ! even if we don't have a water cycle, we might 801 ! need epsi for the wvp definitions in callcorrk.F801 ! need epsi for the wvp definitions in rad_correlatedk.F 802 802 ! or RETV, RLvCp for the thermal plume model 803 803 … … 812 812 if (corrk) then 813 813 ! We initialise the spectral grid here instead of 814 ! at firstcall of callcorrk so we can output XspecIR, XspecVI814 ! at firstcall of rad_correlatedk so we can output XspecIR, XspecVI 815 815 ! when using Dynamico 816 816 print*, "physiq_mod: Correlated-k data base folder:",trim(datadir) … … 821 821 banddir=trim(trim(adjustl(tmp1))//'x'//trim(adjustl(tmp2))) 822 822 banddir=trim(trim(adjustl(corrkdir))//'/'//trim(adjustl(banddir))) 823 call setspi!Basic infrared properties.824 call setspv! Basic visible properties.825 call sugas_corrk! Set up gaseous absorption properties.826 call suaer_corrk! Set up aerosol optical properties.823 call rad_correlatedk_init_thermal !Basic infrared properties. 824 call rad_correlatedk_init_stellar ! Basic visible properties. 825 call rad_correlatedk_read_opacity_tables ! Set up gaseous absorption properties. 826 call rad_correlatedk_ini_aerosol ! Set up aerosol optical properties. 827 827 endif 828 828 … … 877 877 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 878 878 if (season) then 879 call stellarlong(zday,zls)879 call ephemeris_stellar_longitude(zday,zls) 880 880 else 881 call stellarlong(noseason_day,zls)881 call ephemeris_stellar_longitude(noseason_day,zls) 882 882 end if 883 883 884 call orbite(zls,dist_star,declin,right_ascen)884 call ephemeris_orbit(zls,dist_star,declin,right_ascen) 885 885 886 886 if (tlocked) then … … 981 981 ztim3=COS(declin)*SIN(zlss) 982 982 983 call stelang(ngrid,sinlon,coslon,sinlat,coslat, &983 call ephemeris_stellar_angle(ngrid,sinlon,coslon,sinlat,coslat, & 984 984 ztim1,ztim2,ztim3,mu0,fract, flatten) 985 985 … … 989 989 ztim3=-COS(declin)*SIN(2.*pi*(zday-.5)) 990 990 991 call stelang(ngrid,sinlon,coslon,sinlat,coslat, &991 call ephemeris_stellar_angle(ngrid,sinlon,coslon,sinlat,coslat, & 992 992 ztim1,ztim2,ztim3,mu0,fract, flatten) 993 993 else if(diurnal .eqv. .false.) then … … 1008 1008 ! Eclipse incoming sunlight (e.g. Saturn ring shadowing). 1009 1009 if(rings_shadow) then 1010 call call_rings(ngrid, ptime, pday, diurnal)1010 call rad_ring_shadowing(ngrid, ptime, pday, diurnal) 1011 1011 endif 1012 1012 … … 1063 1063 endif !(ok_slab_ocean) 1064 1064 1065 ! standard callcorrk1065 ! standard rad_correlatedk 1066 1066 clearsky=.false. 1067 call callcorrk(ngrid,nlayer,pq,nq,qsurf,zls,&1067 call rad_correlatedk(ngrid,nlayer,pq,nq,qsurf,zls, & 1068 1068 albedo,albedo_equivalent,emis,mu0,pplev,pplay,pt, & 1069 1069 tsurf,fract,dist_star,aerosol,muvar, & … … 1094 1094 if(CLFvarying)then 1095 1095 1096 ! ---> PROBLEMS WITH ALLOCATED ARRAYS : temporary solution in callcorrk: do not deallocate if CLFvarying ...1096 ! ---> PROBLEMS WITH ALLOCATED ARRAYS : temporary solution in rad_correlatedk: do not deallocate if CLFvarying ... 1097 1097 clearsky=.true. 1098 call callcorrk(ngrid,nlayer,pq,nq,qsurf,zls,&1098 call rad_correlatedk(ngrid,nlayer,pq,nq,qsurf,zls, & 1099 1099 albedo,albedo_equivalent1,emis,mu0,pplev,pplay,pt, & 1100 1100 tsurf,fract,dist_star,aerosol,muvar, & … … 1162 1162 ! II.b Call Newtonian cooling scheme 1163 1163 ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 1164 ! call newtrelax(ngrid,nlayer,mu0,sinlat,zpopsk,pt,pplay,pplev,dtrad,firstcall)1165 call newtcool_MOCHA(ngrid,nlayer,coslon,coslat,pt,pplay,firstcall,lastcall,dtrad)1164 ! call rad_netwon_cooling(ngrid,nlayer,mu0,sinlat,zpopsk,pt,pplay,pplev,dtrad,firstcall) 1165 call rad_newton_cooling_MOCHA_intercomparison(ngrid,nlayer,coslon,coslat,pt,pplay,firstcall,lastcall,dtrad) 1166 1166 1167 1167 zdtsurf(1:ngrid) = +(pt(1:ngrid,1)-tsurf(1:ngrid))/ptimestep … … 2299 2299 reffcol(1:ngrid,1:naerkind)=0.0 2300 2300 if(co2cond.and.(iaero_co2.ne.0))then 2301 call co2_reffrad(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_co2))2301 call aerosol_radius_co2(ngrid,nlayer,nq,zq,reffrad(1,1,iaero_co2)) 2302 2302 do ig=1,ngrid 2303 2303 reffcol(ig,iaero_co2) = SUM(zq(ig,1:nlayer,igcm_co2_ice)*reffrad(ig,1:nlayer,iaero_co2)*mass(ig,1:nlayer)) -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_blackbody.F
r4076 r4077 1 subroutine blackl(blalong,blat,blae)1 subroutine rad_blackbody_planck_law_wavelength(blalong,blat,blae) 2 2 3 3 implicit double precision (a-h,o-z) … … 21 21 end 22 22 23 subroutine blackn(blalong,blat,blae)23 subroutine rad_blackbody_planck_law_wavenumber(blalong,blat,blae) 24 24 25 25 implicit double precision (a-h,o-z) -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk.F90
r4076 r4077 1 MODULE callcorrk_mod1 MODULE rad_correlatedk_mod 2 2 3 3 IMPLICIT NONE … … 5 5 CONTAINS 6 6 7 subroutine callcorrk(ngrid,nlayer,pq,nq,qsurf,zls, &7 subroutine rad_correlatedk(ngrid,nlayer,pq,nq,qsurf,zls, & 8 8 albedo,albedo_equivalent,emis,mu0,pplev,pplay,pt, & 9 9 tsurf,fract,dist_star,aerosol,muvar, & … … 27 27 use ioipsl_getin_p_mod, only: getin_p 28 28 use gases_h, only: ngasmx 29 use radii_mod, only : su_aer_radii,co2_reffrad,h2o_reffrad,dust_reffrad,h2so4_reffrad,back2lay_reffrad 30 use aerosol_mod, only : iaero_co2,iaero_h2o,iaero_dust,iaero_h2so4, & 29 use aerosol_radius, only : aerosol_radius_init,aerosol_radius_co2,h2o_reffrad, & 30 aerosol_radius_dust,aerosol_radius_h2so4,aerosol_radius_back2lay 31 use aerosol_global_variables , only : iaero_co2,iaero_h2o,iaero_dust,iaero_h2so4, & 31 32 iaero_back2lay, iaero_aurora, & 32 33 iaero_venus1,iaero_venus2,iaero_venus2p, & 33 34 iaero_venus3,iaero_venusUV 34 use aero pacity_mod, only: aeropacity35 use aero ptproperties_mod, only: aeroptproperties35 use aerosol_opacity_mod, only: aerosol_opacity 36 use aerosol_optical_properties_mod, only: aerosol_optical_properties 36 37 use tracer_h, only: igcm_h2o_ice, igcm_h2o_vap, igcm_co2_ice 37 38 use tracer_h, only: constants_epsi_generic … … 41 42 CLFvarying,tplanckmin,tplanckmax,global1d, & 42 43 generic_condensation, aerovenus, nvarlayer, varspec 43 use optcv_mod, only: optcv 44 use optci_mod, only: optci 45 use sfluxi_mod, only: sfluxi 46 use sfluxv_mod, only: sfluxv 47 use recombin_corrk_mod, only: corrk_recombin, call_recombin 44 use rad_correlatedk_opacities_stellar_mod, & 45 only: rad_correlatedk_opacities_stellar 46 use rad_correlatedk_opacities_thermal_mod, & 47 only: rad_correlatedk_opacities_thermal 48 use rad_correlatedk_fluxes_thermal_mod, & 49 only: rad_correlatedk_fluxes_thermal 50 use rad_correlatedk_fluxes_stellar_mod, & 51 only: rad_correlatedk_fluxes_stellar 52 use rad_correlatedk_online_recombination_mod, & 53 only: corrk_recombin, & 54 rad_correlatedk_recombination_main 48 55 use pindex_mod, only: pindex 49 56 use generic_cloud_common_h, only: Psat_generic, epsi_generic … … 111 118 REAL,INTENT(OUT) :: OSR_nu(ngrid,L_NSPECTV) ! Outgoing SW radiation in each band (Normalized to the band width (W/m2/cm-1). 112 119 REAL,INTENT(OUT) :: GSR_nu(ngrid,L_NSPECTV) ! Surface SW radiation in each band (Normalized to the band width (W/m2/cm-1). 113 REAL,INTENT(OUT) :: tau_col(ngrid) ! Diagnostic from aero pacity.120 REAL,INTENT(OUT) :: tau_col(ngrid) ! Diagnostic from aerosol_opacity. 114 121 REAL,INTENT(OUT) :: albedo_equivalent(ngrid) ! Spectrally Integrated Albedo. For Diagnostic. By MT2015 115 122 REAL,INTENT(OUT) :: totcloudfrac(ngrid) ! Column Fraction of clouds (%). … … 148 155 REAL*8 tlevrad(L_LEVELS),plevrad(L_LEVELS) 149 156 150 ! Optical values for the optci/cv subroutines157 ! Optical values for the rad_correlatedk_opacities_thermal/cv subroutines 151 158 REAL*8 stel(L_NSPECTV),stel_fract(L_NSPECTV) 152 159 ! NB: Arrays below are "save" to avoid reallocating them at every call … … 200 207 character(len=10) :: tmp2 201 208 character(len=100) :: message 202 character(len=10),parameter :: subname=" callcorrk"209 character(len=10),parameter :: subname="rad_correlatedk" 203 210 204 211 ! For fixed water vapour profiles. … … 242 249 if(firstcall) then 243 250 244 ! test on allocated necessary because of CLFvarying (two calls to callcorrk in physiq)251 ! test on allocated necessary because of CLFvarying (two calls to rad_correlatedk in physiq) 245 252 if(.not.allocated(QVISsQREF3d)) then 246 253 allocate(QVISsQREF3d(ngrid,nlayer,L_NSPECTV,naerkind)) … … 308 315 endif 309 316 310 !!! ALLOCATED instances are necessary because of CLFvarying (strategy to call callcorrk twice in physiq...)317 !!! ALLOCATED instances are necessary because of CLFvarying (strategy to call rad_correlatedk twice in physiq...) 311 318 IF(.not.ALLOCATED(QREFvis3d))THEN 312 319 ALLOCATE(QREFvis3d(ngrid,nlayer,naerkind), stat=ok) … … 343 350 #endif 344 351 345 call su_aer_radii(ngrid,nlayer,reffrad,nueffrad)352 call aerosol_radius_init(ngrid,nlayer,reffrad,nueffrad) 346 353 347 354 … … 351 358 352 359 !this block is now done at firstcall of physiq_mod 353 ! print*, " callcorrk: Correlated-k data base folder:",trim(datadir)360 ! print*, "rad_correlatedk: Correlated-k data base folder:",trim(datadir) 354 361 ! call getin_p("corrkdir",corrkdir) 355 362 ! print*, "corrkdir = ",corrkdir … … 359 366 ! banddir=trim(adjustl(corrkdir))//'/'//trim(adjustl(banddir)) 360 367 361 ! call setspi! Basic infrared properties.362 ! call setspv! Basic visible properties.363 ! call sugas_corrk! Set up gaseous absorption properties.364 ! call suaer_corrk! Set up aerosol optical properties.368 ! call rad_correlatedk_init_thermal ! Basic infrared properties. 369 ! call rad_correlatedk_init_stellar ! Basic visible properties. 370 ! call rad_correlatedk_read_opacity_tables ! Set up gaseous absorption properties. 371 ! call rad_correlatedk_ini_aerosol ! Set up aerosol optical properties. 365 372 366 373 367 ! now that L_NGAUSS has been initialized (by sugas_corrk)374 ! now that L_NGAUSS has been initialized (by rad_correlatedk_read_opacity_tables ) 368 375 ! allocate related arrays 369 376 if(.not.allocated(dtaui)) then … … 446 453 447 454 if((igcm_h2o_vap.eq.0) .and. varactive .and. water)then 448 message='varactive in callcorrk but no h2o_vap tracer.'455 message='varactive in rad_correlatedk but no h2o_vap tracer.' 449 456 call abort_physic(subname,message,1) 450 457 endif … … 485 492 486 493 if ((iaer.eq.iaero_co2).and.tracer.and.(igcm_co2_ice.gt.0)) then ! Treat condensed co2 particles. 487 call co2_reffrad(ngrid,nlayer,nq,pq,reffrad(1,1,iaero_co2))494 call aerosol_radius_co2(ngrid,nlayer,nq,pq,reffrad(1,1,iaero_co2)) 488 495 489 496 call planetwide_maxval(reffrad(:,:,iaero_co2),maxvalue) … … 517 524 518 525 if(iaer.eq.iaero_dust)then 519 call dust_reffrad(ngrid,nlayer,reffrad(1,1,iaero_dust))526 call aerosol_radius_dust(ngrid,nlayer,reffrad(1,1,iaero_dust)) 520 527 if (is_master) then 521 528 print*,'Dust particle size = ',reffrad(1,1,iaer)/1.e-6,' um' … … 524 531 525 532 if(iaer.eq.iaero_h2so4)then 526 call h2so4_reffrad(ngrid,nlayer,reffrad(1,1,iaero_h2so4))533 call aerosol_radius_h2so4(ngrid,nlayer,reffrad(1,1,iaero_h2so4)) 527 534 if (is_master) then 528 535 print*,'H2SO4 particle size =',reffrad(1,1,iaer)/1.e-6,' um' … … 531 538 532 539 if(iaer.eq.iaero_back2lay)then 533 call back2lay_reffrad(ngrid,reffrad(1,1,iaero_back2lay),nlayer,pplev)534 endif 535 536 ! For n-layer aerosol size set once for all at firstcall in su_aer_radii540 call aerosol_radius_back2lay(ngrid,reffrad(1,1,iaero_back2lay),nlayer,pplev) 541 endif 542 543 ! For n-layer aerosol size set once for all at firstcall in aerosol_radius_init 537 544 538 545 ! if(iaer.eq.iaero_aurora)then … … 549 556 550 557 ! Get 3D aerosol optical properties. 551 call aero ptproperties(ngrid,nlayer,reffrad,nueffrad, &558 call aerosol_optical_properties(ngrid,nlayer,reffrad,nueffrad, & 552 559 QVISsQREF3d,omegaVIS3d,gVIS3d, & 553 560 QIRsQREF3d,omegaIR3d,gIR3d, & … … 555 562 556 563 ! Get aerosol optical depths. 557 call aero pacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,zls,aerosol, &564 call aerosol_opacity(ngrid,nlayer,nq,pplay,pplev,pt,pq,zls,aerosol, & 558 565 reffrad,nueffrad,QREFvis3d,QREFir3d, & 559 566 tau_col,cloudfrac,totcloudfrac,clearsky) … … 692 699 (pplev(ig,L_NLAYRAD-k)-pplev(ig,L_NLAYRAD-k+1)) 693 700 ! As 'aerosol' is at reference (visible) wavelenght we scale it as 694 ! it will be multplied by qxi/v in optci/v701 ! it will be multplied by qxi/v in rad_correlatedk_opacities_thermal/v 695 702 temp=aerosol(ig,L_NLAYRAD-k,iaer)/QREFvis3d(ig,L_NLAYRAD-k,iaer) 696 703 tauaero(2*k+2,iaer)=max(temp*pweight,0.d0) … … 918 925 qvar(1)=qvar(2) 919 926 920 write(*,*)trim(subname),' :Warning: reducing qvar in callcorrk.'927 write(*,*)trim(subname),' :Warning: reducing qvar in rad_correlatedk.' 921 928 write(*,*)trim(subname),' :Temperature profile no longer consistent ', & 922 929 'with saturated H2O. qsat=',satval … … 1018 1025 ! -- JVO 20 : Also add a sanity test checking that tlevrad is 1019 1026 ! within Planck function temperature boundaries, 1020 ! which would cause gfluxi/sfluxito crash.1027 ! which would cause rad_correlatedk_fluxes_solver_thermal/rad_correlatedk_fluxes_thermal to crash. 1021 1028 do k=1,L_LEVELS 1022 1029 … … 1127 1134 ! Recombine reference corrk tables if needed - Added by JVO, 2020. 1128 1135 if (corrk_recombin) then 1129 call call_recombin(ig,nlayer,pq(ig,:,:),pplay(ig,:),pt(ig,:),qvar(:),tmid(:),pmid(:))1136 call rad_correlatedk_recombination_main(ig,nlayer,pq(ig,:,:),pplay(ig,:),pt(ig,:),qvar(:),tmid(:),pmid(:)) 1130 1137 endif 1131 1138 ! ---------------------------------------------------------------- … … 1149 1156 endif 1150 1157 1151 call optcv(dtauv,tauv,taucumv,plevrad, & 1152 qxvaer,qsvaer,gvaer,wbarv,cosbv,tauaero, & 1158 call rad_correlatedk_opacities_stellar(dtauv, & 1159 tauv,taucumv,plevrad, & 1160 qxvaer,qsvaer,gvaer,wbarv,cosbv,tauaero, & 1153 1161 tmid,pmid,taugsurf,qvar,muvarrad,fracvari) 1154 1162 1155 call sfluxv(dtauv,tauv,taucumv,albv,dwnv,wbarv,cosbv, & 1156 acosz,stel_fract, & 1157 nfluxtopv,fluxtopvdn,nfluxoutv_nu,nfluxgndv_nu, & 1163 call rad_correlatedk_fluxes_stellar(dtauv,tauv, & 1164 taucumv,albv,dwnv,wbarv,cosbv, & 1165 acosz,stel_fract, & 1166 nfluxtopv,fluxtopvdn, & 1167 nfluxoutv_nu,nfluxgndv_nu, & 1158 1168 fmnetv,fluxupv,fluxdnv,fzerov,taugsurf) 1159 1169 … … 1192 1202 !----------------------------------------------------------------------- 1193 1203 1194 call optci(plevrad,tlevrad,dtaui,taucumi, & 1195 qxiaer,qsiaer,giaer,cosbi,wbari,tauaero,tmid,pmid, & 1204 call rad_correlatedk_opacities_thermal(plevrad, & 1205 tlevrad,dtaui,taucumi, & 1206 qxiaer,qsiaer,giaer,cosbi,wbari,tauaero,tmid,pmid, & 1196 1207 taugsurfi,qvar,muvarrad,fracvari) 1197 1208 1198 call sfluxi(plevrad,tlevrad,dtaui,taucumi,ubari,albi, & 1199 wnoi,dwni,cosbi,wbari,nfluxtopi,nfluxtopi_nu, & 1209 call rad_correlatedk_fluxes_thermal(plevrad, & 1210 tlevrad,dtaui,taucumi,ubari,albi, & 1211 wnoi,dwni,cosbi,wbari,nfluxtopi,nfluxtopi_nu, & 1200 1212 fmneti,fluxupi,fluxdni,fluxupi_nu,fzeroi,taugsurfi) 1201 1213 … … 1346 1358 1347 1359 1348 end subroutine callcorrk1349 1350 END MODULE callcorrk_mod1360 end subroutine rad_correlatedk 1361 1362 END MODULE rad_correlatedk_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_continuum_interpolation.F90
r4076 r4077 1 module interpolate_continuum_mod1 module rad_correlatedk_continuum_interpolation_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 subroutine interpolate_continuum(filename,igas_X,igas_Y,c_WN,ind_WN,temp,pres_X,pres_Y,abs_coef,firstcall)7 subroutine rad_correlatedk_continuum_interpolation(filename,igas_X,igas_Y,c_WN,ind_WN,temp,pres_X,pres_Y,abs_coef,firstcall) 8 8 9 9 !================================================================== … … 53 53 54 54 character(len=512) :: line 55 character(len=21),parameter :: rname=" interpolate_continuum"55 character(len=21),parameter :: rname="rad_correlatedk_continuum_interpolation" 56 56 57 57 integer i, pos, iT, iW, iB, count_norm, igas … … 206 206 207 207 208 if(firstcall)then ! called by sugas_corrkonly208 if(firstcall)then ! called by rad_correlatedk_read_opacity_tables only 209 209 if (is_master) print*,'----------------------------------------------------' 210 if (is_master) print*,'Initialising continuum ( interpolate_continuumroutine) from ', trim(filename)210 if (is_master) print*,'Initialising continuum (rad_correlatedk_continuum_interpolation routine) from ', trim(filename) 211 211 212 212 !$OMP MASTER … … 216 216 if (ios.ne.0) then ! file not found 217 217 if (is_master) then 218 write(*,*) 'Error from interpolate_continuumroutine'218 write(*,*) 'Error from rad_correlatedk_continuum_interpolation routine' 219 219 write(*,*) 'Data file ',trim(filename),' not found.' 220 220 write(*,*) 'Check that your path to datagcm:',trim(datadir) … … 650 650 !print*,'So the absorption is ',abs_coef,' m^-1' 651 651 652 end subroutine interpolate_continuum652 end subroutine rad_correlatedk_continuum_interpolation 653 653 654 654 … … 836 836 end subroutine interpolate_T_abs_coeff 837 837 838 end module interpolate_continuum_mod838 end module rad_correlatedk_continuum_interpolation_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_fluxes_solver_stellar.F
r4076 r4077 1 module gfluxv_mod1 module rad_correlatedk_fluxes_solver_stellar_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 SUBROUTINE GFLUXV(DTDEL,TDEL,TAUCUMIN,WDEL,CDEL,UBAR0,F0PI,RSF,8 * BTOP,BSURF,FMIDP,FMIDM,DIFFV,FLUXUP,FLUXDN)9 7 SUBROUTINE rad_correlatedk_fluxes_solver_stellar(DTDEL, 8 * TDEL,TAUCUMIN,WDEL,CDEL,UBAR0,F0PI,RSF,BTOP, 9 * BSURF,FMIDP,FMIDM,DIFFV,FLUXUP,FLUXDN) 10 10 11 11 C THIS SUBROUTINE TAKES THE OPTICAL CONSTANTS AND BOUNDARY CONDITIONS … … 19 19 C THE FLUXES DIRECTLY USING THE GENERALIZED NOTATION OF MEADOR AND WEAVOR 20 20 C J.A.S., 37, 630-642, 1980. 21 C THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVERAND IS DOUBLE PRECISION SO MANY22 C VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER21 C THE TRI-DIAGONAL MATRIX SOLVER IS rad_tridiagonal_matrix_solver AND IS DOUBLE PRECISION SO MANY 22 C VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN rad_tridiagonal_matrix_solver 23 23 C 24 24 C NLL = NUMBER OF LEVELS (NAYER + 1) THAT WILL BE SOLVED … … 200 200 END DO 201 201 202 CALL DSOLVER(NAYER,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,203 * BSURF,RSF,XK1,XK2)202 CALL rad_tridiagonal_matrix_solver(NAYER,GAMA,CP,CM,CPM1, 203 * CMM1,E1,E2,E3,E4,BTOP,BSURF,RSF,XK1,XK2) 204 204 205 205 C NOW WE CALCULATE THE FLUXES AT THE MIDPOINTS OF THE LAYERS. … … 335 335 336 336 337 END SUBROUTINE GFLUXV338 339 end module gfluxv_mod337 END SUBROUTINE rad_correlatedk_fluxes_solver_stellar 338 339 end module rad_correlatedk_fluxes_solver_stellar_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_fluxes_solver_thermal.F
r4076 r4077 1 module gfluxi_mod1 module rad_correlatedk_fluxes_solver_thermal_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 SUBROUTINE GFLUXI(NLL,TLEV,NW,DW,DTAU,TAUCUM,W0,COSBAR,UBARI, 7 SUBROUTINE rad_correlatedk_fluxes_solver_thermal(NLL, 8 * TLEV,NW,DW,DTAU,TAUCUM,W0,COSBAR,UBARI, 8 9 * RSF,BTOP,BSURF,FTOPUP,FMIDP,FMIDM) 9 10 … … 23 24 ! HAS LEVEL N ON TOP AND LEVEL N+1 ON BOTTOM. OPTICAL DEPTH INCREASES 24 25 ! FROM TOP TO BOTTOM. SEE C.P. MCKAY, TGM NOTES. 25 ! THE TRI-DIAGONAL MATRIX SOLVER IS DSOLVERAND IS DOUBLE PRECISION SO MANY26 ! VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN DSOLVER26 ! THE TRI-DIAGONAL MATRIX SOLVER IS rad_tridiagonal_matrix_solver AND IS DOUBLE PRECISION SO MANY 27 ! VARIABLES ARE PASSED AS SINGLE THEN BECOME DOUBLE IN rad_tridiagonal_matrix_solver 27 28 ! 28 29 ! NLL = NUMBER OF LEVELS (NLAYERS + 1) MUST BE LESS THAT NL (101) … … 81 82 ! open(888,file='W0') 82 83 ! if ((W0(L).eq.0.).or.(W0(L).eq.1.)) then 83 ! write(888,*) W0(L), L, ' gfluxi'84 ! write(888,*) W0(L), L, 'rad_correlatedk_fluxes_solver_thermal' 84 85 ! endif 85 86 ! Prevent this with an if statement: … … 170 171 END DO 171 172 172 ! B81=BTOP ! RENAME BEFORE CALLING DSOLVER- used to be to set173 ! B81=BTOP ! RENAME BEFORE CALLING rad_tridiagonal_matrix_solver - used to be to set 173 174 ! B82=BSURF ! them to real*8 - but now everything is real*8 174 175 ! R81=RSF ! so this may not be necessary … … 176 177 ! DOUBLE PRECISION TRIDIAGONAL SOLVER 177 178 178 CALL DSOLVER(NLAYER,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP,179 * BSURF,RSF,XK1,XK2)179 CALL rad_tridiagonal_matrix_solver(NLAYER,GAMA,CP,CM,CPM1, 180 * CMM1,E1,E2,E3,E4,BTOP,BSURF,RSF,XK1,XK2) 180 181 181 182 ! NOW WE CALCULATE THE FLUXES AT THE MIDPOINTS OF THE LAYERS. … … 242 243 243 244 244 END SUBROUTINE GFLUXI245 246 end module gfluxi_mod245 END SUBROUTINE rad_correlatedk_fluxes_solver_thermal 246 247 end module rad_correlatedk_fluxes_solver_thermal_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_fluxes_stellar.F
r4076 r4077 1 module sfluxv_mod1 module rad_correlatedk_fluxes_stellar_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 SUBROUTINE SFLUXV(DTAUV,TAUV,TAUCUMV,RSFV,DWNV,WBARV,COSBV, 7 SUBROUTINE rad_correlatedk_fluxes_stellar(DTAUV,TAUV, 8 * TAUCUMV,RSFV,DWNV,WBARV,COSBV, 8 9 * UBAR0,STEL,NFLUXTOPV,FLUXTOPVDN, 9 10 * NFLUXOUTV_nu,NFLUXGNDV_nu, … … 13 14 use radinc_h, only: L_NLAYRAD, L_NLEVRAD 14 15 use radcommon_h, only: tlimit, gweight 15 use gfluxv_mod, only: gfluxv 16 use rad_correlatedk_fluxes_solver_stellar_mod, only: 17 * rad_correlatedk_fluxes_solver_stellar 16 18 17 19 implicit none … … 101 103 102 104 103 CALL GFLUXV(DTAUV(1,NW,NG),TAUV(1,NW,NG),TAUCUMV(1,NW,NG), 104 * WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV(NW), 105 * BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN) 105 CALL rad_correlatedk_fluxes_solver_stellar(DTAUV(1,NW,NG), 106 * TAUV(1,NW,NG),TAUCUMV(1,NW,NG), 107 * WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV(NW), 108 * BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN) 106 109 107 110 C NOW CALCULATE THE CUMULATIVE VISIBLE NET FLUX … … 159 162 C RETURN FLUXES FOR A GIVEN NT 160 163 161 CALL GFLUXV(DTAUV(1,NW,NG),TAUV(1,NW,NG),TAUCUMV(1,NW,NG), 162 * WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV(NW), 163 * BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN) 164 CALL rad_correlatedk_fluxes_solver_stellar(DTAUV(1,NW,NG), 165 * TAUV(1,NW,NG),TAUCUMV(1,NW,NG), 166 * WBARV(1,NW,NG),COSBV(1,NW,NG),UBAR0,F0PI,RSFV(NW), 167 * BTOP,BSURF,FMUPV,FMDV,DIFFV,FLUXUP,FLUXDN) 164 168 165 169 … … 193 197 194 198 195 END SUBROUTINE SFLUXV196 197 end module sfluxv_mod198 199 END SUBROUTINE rad_correlatedk_fluxes_stellar 200 201 end module rad_correlatedk_fluxes_stellar_mod 202 -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_fluxes_thermal.F
r4076 r4077 1 module sfluxi_mod1 module rad_correlatedk_fluxes_thermal_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 SUBROUTINE SFLUXI(PLEV,TLEV,DTAUI,TAUCUMI,UBARI,RSFI,WNOI,DWNI, 7 SUBROUTINE rad_correlatedk_fluxes_thermal(PLEV,TLEV, 8 * DTAUI,TAUCUMI,UBARI,RSFI,WNOI,DWNI, 8 9 * COSBI,WBARI,NFLUXTOPI,NFLUXTOPI_nu, 9 10 * FMNETI,fluxupi,fluxdni,fluxupi_nu, … … 14 15 use radcommon_h, only: planckir, tlimit,sigma, gweight 15 16 use comcstfi_mod, only: pi 16 use gfluxi_mod, only: gfluxi 17 use rad_correlatedk_fluxes_solver_thermal_mod, 18 * only: rad_correlatedk_fluxes_solver_thermal 17 19 18 20 implicit none … … 132 134 ! WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER 133 135 134 CALL GFLUXI(NLEVRAD,TLEV,NW,DWNI(NW),DTAUI(1,NW,NG), 136 CALL rad_correlatedk_fluxes_solver_thermal(NLEVRAD, 137 * TLEV,NW,DWNI(NW),DTAUI(1,NW,NG), 135 138 * TAUCUMI(1,NW,NG), 136 139 * WBARI(1,NW,NG),COSBI(1,NW,NG),UBARI,RSFI,BTOP, … … 175 178 ! WITHIN EACH INTERVAL AT THE MIDPOINT WAVENUMBER 176 179 177 CALL GFLUXI(NLEVRAD,TLEV,NW,DWNI(NW),DTAUI(1,NW,NG), 180 CALL rad_correlatedk_fluxes_solver_thermal(NLEVRAD, 181 * TLEV,NW,DWNI(NW),DTAUI(1,NW,NG), 178 182 * TAUCUMI(1,NW,NG), 179 183 * WBARI(1,NW,NG),COSBI(1,NW,NG),UBARI,RSFI,BTOP, … … 200 204 ! *** END OF MAJOR SPECTRAL INTERVAL LOOP IN THE INFRARED**** 201 205 202 END SUBROUTINE SFLUXI206 END SUBROUTINE rad_correlatedk_fluxes_thermal 203 207 204 end module sfluxi_mod208 end module rad_correlatedk_fluxes_thermal_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_ini_aerosol.F90
r4076 r4077 1 module suaer_corrk_mod1 module rad_correlatedk_ini_aerosol_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 subroutine suaer_corrk7 subroutine rad_correlatedk_ini_aerosol 8 8 9 9 ! inputs … … 16 16 use radcommon_h, only: radiustab,nsize,tstellar 17 17 use radcommon_h, only: qrefvis,qrefir,omegarefir !,omegarefvis 18 use aerosol_ mod, only: noaero,iaero_co2,iaero_h2o,iaero_dust,iaero_h2so419 use aerosol_ mod, only: iaero_back2lay,iaero_nh3,iaero_nlay,iaero_aurora20 use aerosol_ mod, only: iaero_venus1,iaero_venus2,iaero_venus2p21 use aerosol_ mod, only: iaero_venus3,iaero_venusUV22 use aerosol_ mod, only: iaero_generic,i_rgcs_ice18 use aerosol_global_variables , only: noaero,iaero_co2,iaero_h2o,iaero_dust,iaero_h2so4 19 use aerosol_global_variables , only: iaero_back2lay,iaero_nh3,iaero_nlay,iaero_aurora 20 use aerosol_global_variables , only: iaero_venus1,iaero_venus2,iaero_venus2p 21 use aerosol_global_variables , only: iaero_venus3,iaero_venusUV 22 use aerosol_global_variables , only: iaero_generic,i_rgcs_ice 23 23 use callkeys_mod, only: tplanet, optprop_back2lay_vis, optprop_back2lay_ir, & 24 24 optprop_aeronlay_vis, optprop_aeronlay_ir, & … … 89 89 CHARACTER(LEN=132) :: scanline ! ASCII file scanning line 90 90 91 ! I/O of "aer ave" (subroutine that spectrally averages91 ! I/O of "aerosol_optical_properties_averaging" (subroutine that spectrally averages 92 92 ! the single scattering parameters) 93 93 … … 342 342 else 343 343 ! If you want to add another specie, copy,paste & adapt the elseif block up here to your new specie (LT 2022) 344 call abort_physic(" suaer_corrk", "Unknown specie in radiative generic condensable species",1)344 call abort_physic("rad_correlatedk_ini_aerosol", "Unknown specie in radiative generic condensable species",1) 345 345 endif 346 346 endif … … 393 393 ENDIF 394 394 IF(.NOT.file_ok) THEN 395 write(*,*)' suaer_corrk: Problem opening ',&395 write(*,*)'rad_correlatedk_ini_aerosol: Problem opening ',& 396 396 TRIM(file_id(iaer,idomain)) 397 397 write(*,*)'It should be in: ',TRIM(datadir)//'/'//TRIM(aerdir) … … 405 405 write(*,*)' http://www.lmd.jussieu.fr/',& 406 406 '~lmdz/planets/generic/datagcm/' 407 CALL abort_physic(" suaer_corrk", "Unable to read file",1)407 CALL abort_physic("rad_correlatedk_ini_aerosol", "Unable to read file",1) 408 408 ENDIF 409 409 … … 425 425 endwhile = .true. 426 426 CASE DEFAULT reading1_seq ! ---------------------------- 427 CALL abort_physic(" suaer_corrk","Error while loading optical properties",1)427 CALL abort_physic("rad_correlatedk_ini_aerosol","Error while loading optical properties",1) 428 428 END SELECT reading1_seq ! ============================== 429 429 ENDIF … … 505 505 endwhile = .true. 506 506 CASE DEFAULT reading2_seq ! ---------------------------- 507 CALL abort_physic(" suaer_corrk","Error while loading optical properties",1)507 CALL abort_physic("rad_correlatedk_ini_aerosol","Error while loading optical properties",1) 508 508 END SELECT reading2_seq ! ============================== 509 509 ENDIF … … 551 551 ! Averaged optical properties (GCM channels) 552 552 553 CALL aer ave_new( nwvl,&553 CALL aerosol_optical_properties_averaging ( nwvl,& 554 554 wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),& 555 555 lamref,epref,tstellar,& … … 580 580 581 581 ! epav is <QIR>/Qext(lamrefir) since epref=1 582 ! Note: aer avealso computes the extinction coefficient at582 ! Note: aerosol_optical_properties_averaging also computes the extinction coefficient at 583 583 ! the reference wavelength. This is called QREFvis or QREFir 584 584 ! (not epref, which is a different parameter). … … 586 586 ! radcommon_h.F90 587 587 588 CALL aer ave_new( nwvl,&588 CALL aerosol_optical_properties_averaging ( nwvl,& 589 589 wvl(:),ep(:,isize),omeg(:,isize),gfactor(:,isize),& 590 590 lamref,epref,tplanet,& … … 622 622 deallocate(file_id) 623 623 624 end subroutine suaer_corrk624 end subroutine rad_correlatedk_ini_aerosol 625 625 626 end module suaer_corrk_mod626 end module rad_correlatedk_ini_aerosol_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_init_stellar.F90
r4076 r4077 1 module setspv_mod1 module rad_correlatedk_init_stellar_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 subroutine setspv7 subroutine rad_correlatedk_init_stellar 8 8 9 9 !================================================================== … … 15 15 ! Authors 16 16 ! ------- 17 ! Adapted from setspvin the NASA Ames radiative code by17 ! Adapted from rad_correlatedk_init_stellar in the NASA Ames radiative code by 18 18 ! Robin Wordsworth (2009). 19 19 ! 20 20 ! Called by 21 21 ! --------- 22 ! callcorrk.F22 ! rad_correlatedk.F 23 23 ! 24 24 ! Calls 25 25 ! ----- 26 ! ave_stelspec.F26 ! rad_correlatedk_stellar_spectrum .F 27 27 ! 28 28 !================================================================== … … 33 33 use datafile_mod, only: datadir 34 34 use callkeys_mod, only: Fat1AU 35 use ave_stelspec_mod, only: ave_stelspec35 use rad_correlatedk_stellar_spectrum_mod, only: rad_correlatedk_stellar_spectrum 36 36 37 37 implicit none … … 66 66 if(.not.file_ok) then 67 67 write(*,*)'The file ',TRIM(file_path) 68 write(*,*)'was not found by setspv.F90, exiting.'68 write(*,*)'was not found by rad_correlatedk_init_stellar.F90, exiting.' 69 69 write(*,*)'Check that your path to datagcm:',trim(datadir) 70 70 write(*,*)' is correct. You can change it in callphys.def with:' 71 71 write(*,*)' datadir = /absolute/path/to/datagcm' 72 72 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 73 call abort_physic(" setspv", "Unable to read file",1)73 call abort_physic("rad_correlatedk_init_stellar", "Unable to read file",1) 74 74 endif 75 75 … … 86 86 close(131) 87 87 88 write(*,*) ' setspv: L_NSPECTV = ',L_NSPECTV, 'in the model '88 write(*,*) 'rad_correlatedk_init_stellar: L_NSPECTV = ',L_NSPECTV, 'in the model ' 89 89 write(*,*) ' there are ',nb, 'entries in ',TRIM(file_path) 90 90 if(nb.ne.L_NSPECTV) then 91 91 write(*,*) 'MISMATCH !! I stop here' 92 call abort_physic(" setspv","The number of entries in narrowbands_VI.in does not match with L_NSPECTV",1)92 call abort_physic("rad_correlatedk_init_stellar","The number of entries in narrowbands_VI.in does not match with L_NSPECTV",1) 93 93 endif 94 94 … … 106 106 !$OMP BARRIER 107 107 108 print*,' setspv: VI band limits:'108 print*,'rad_correlatedk_init_stellar: VI band limits:' 109 109 do M=1,L_NSPECTV+1 110 110 print*,m,'-->',BWNV(M),' cm^-1' … … 127 127 ! Set up stellar spectrum 128 128 129 write(*,*)' setspv: Interpolating stellar spectrum from the hires data...'130 call ave_stelspec(STELLAR)129 write(*,*)'rad_correlatedk_init_stellar: Interpolating stellar spectrum from the hires data...' 130 call rad_correlatedk_stellar_spectrum (STELLAR) 131 131 132 132 ! Sum the stellar flux, and write out the result. … … 136 136 sum = sum+STELLARF(N) 137 137 end do 138 write(6,'(" setspv: Stellar flux at 1 AU = ",f9.2," W m-2")') sum138 write(6,'("rad_correlatedk_init_stellar: Stellar flux at 1 AU = ",f9.2," W m-2")') sum 139 139 print*,' ' 140 140 141 END subroutine setspv141 END subroutine rad_correlatedk_init_stellar 142 142 143 end module setspv_mod143 end module rad_correlatedk_init_stellar_mod 144 144 -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_init_thermal.F90
r4076 r4077 1 subroutine setspi1 subroutine rad_correlatedk_init_thermal 2 2 3 3 !================================================================== … … 9 9 ! Authors 10 10 ! ------- 11 ! Adapted from setspiin the NASA Ames radiative code by11 ! Adapted from rad_correlatedk_init_thermal in the NASA Ames radiative code by 12 12 ! Robin Wordsworth (2009). 13 13 ! 14 14 ! Called by 15 15 ! --------- 16 ! callcorrk.F16 ! rad_correlatedk.F 17 17 ! 18 18 ! Calls … … 82 82 if(.not.file_ok) then 83 83 write(*,*)'The file ',TRIM(file_path) 84 write(*,*)'was not found by setspi.F90, exiting.'84 write(*,*)'was not found by rad_correlatedk_init_thermal.F90, exiting.' 85 85 write(*,*)'Check that your path to datagcm:',trim(datadir) 86 86 write(*,*)' is correct. You can change it in callphys.def with:' 87 87 write(*,*)' datadir = /absolute/path/to/datagcm' 88 88 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 89 call abort_physic(" setspi","Unable to read file",1)89 call abort_physic("rad_correlatedk_init_thermal","Unable to read file",1) 90 90 endif 91 91 … … 98 98 do while (ierr==0) 99 99 read(131,*,iostat=ierr) dummy 100 ! write(*,*) ' setspi: file_entries:',dummy,'ierr=',ierr100 ! write(*,*) 'rad_correlatedk_init_thermal: file_entries:',dummy,'ierr=',ierr 101 101 if (ierr==0) nb=nb+1 102 102 enddo 103 103 close(131) 104 104 105 write(*,*) ' setspi: L_NSPECTI = ',L_NSPECTI, 'in the model '105 write(*,*) 'rad_correlatedk_init_thermal: L_NSPECTI = ',L_NSPECTI, 'in the model ' 106 106 write(*,*) ' there are ',nb, 'entries in ',TRIM(file_path) 107 107 if(nb.ne.L_NSPECTI) then 108 108 write(*,*) 'MISMATCH !! I stop here' 109 call abort_physic(" setspi","The number of entries in narrowbands_IR.in does not match with L_NSPECTI",1)109 call abort_physic("rad_correlatedk_init_thermal","The number of entries in narrowbands_IR.in does not match with L_NSPECTI",1) 110 110 endif 111 111 … … 124 124 125 125 print*,'' 126 print*,' setspi: IR band limits:'126 print*,'rad_correlatedk_init_thermal: IR band limits:' 127 127 do M=1,L_NSPECTI+1 128 128 print*,m,'-->',BWNI(M),' cm^-1' … … 148 148 149 149 print*,'' 150 print*,' setspi: Current Planck integration range:'150 print*,'rad_correlatedk_init_thermal: Current Planck integration range:' 151 151 print*,'T = ',dble(NTstart)/NTfac, ' to ',dble(NTstop)/NTfac,' K.' 152 152 … … 182 182 ! force planck=sigma*eps*T^4 for each temperature in array 183 183 if(forceEC)then 184 print*,' setspi: Force F=sigma*eps*T^4 for all values of T!'184 print*,'rad_correlatedk_init_thermal: Force F=sigma*eps*T^4 for all values of T!' 185 185 do nt=NTstart,NTstop 186 186 plancksum=0.0D0 … … 207 207 plancksum=plancksum+planckir(NW,nt-NTstart+1)*DWNI(NW)*pi 208 208 end do 209 print*,' setspi: At lower limit:'209 print*,'rad_correlatedk_init_thermal: At lower limit:' 210 210 print*,'in model sig*T^4 = ',plancksum,' W m^-2' 211 211 print*,'actual sig*T^4 = ',sigma*(dble(nt)/NTfac)**4,' W m^-2' … … 217 217 plancksum=plancksum+planckir(NW,nt-NTstart+1)*DWNI(NW)*pi 218 218 end do 219 print*,' setspi: At upper limit:'219 print*,'rad_correlatedk_init_thermal: At upper limit:' 220 220 print*,'in model sig*T^4 = ',plancksum,' W m^-2' 221 221 print*,'actual sig*T^4 = ',sigma*(dble(nt)/NTfac)**4,' W m^-2' … … 224 224 225 225 return 226 end subroutine setspi226 end subroutine rad_correlatedk_init_thermal -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_online_recombination.F90
r4076 r4077 1 MODULE r ecombin_corrk_mod1 MODULE rad_correlatedk_online_recombination_mod 2 2 3 3 ! … … 5 5 ! 6 6 ! This module contains the following subroutines : 7 ! - ini_recombin: From modern traceur.def options check if we will use recombining and for which species. Called by initracer.8 ! - su_recombin : Initialise tables. Called by sugas_corrk9 ! - call_recombin : Test profile of species and decide whether to call recombin_corrk. Called by callcork10 ! - r ecombin_corrk : The core algorithm properly recombining corrk tables. Called by callrecombin_corrk.7 ! - rad_correlatedk_recombination_init : From modern traceur.def options check if we will use recombining and for which species. Called by initracer. 8 ! - rad_correlatedk_recombination_setup : Initialise tables. Called by rad_correlatedk_read_opacity_tables 9 ! - rad_correlatedk_recombination_main : Test profile of species and decide whether to call rad_correlatedk_online_recombination. Called by callcork 10 ! - rad_correlatedk_online_recombination : The core algorithm properly recombining corrk tables. 11 11 ! 12 12 … … 36 36 !$OMP THREADPRIVATE(all_otf) 37 37 38 ! Following arrays are allocated in su_recombin (excepted otf2tot_idx, in ini_recombin) and deallocated in callcork lastcall38 ! Following arrays are allocated in rad_correlatedk_recombination_setup (excepted otf2tot_idx, in rad_correlatedk_recombination_init) and deallocated in callcork lastcall 39 39 REAL*8, save, DIMENSION(:,:,:,:,:), ALLOCATABLE :: gasi_recomb, gasv_recomb 40 40 REAL*8, save, DIMENSION(:,:,:,:,:), ALLOCATABLE :: gasi_otf, gasv_otf … … 52 52 53 53 54 SUBROUTINE ini_recombin54 SUBROUTINE rad_correlatedk_recombination_init 55 55 56 56 USE tracer_h … … 101 101 102 102 write(*,*) 103 write(*,*) ' ini_recombin: found specie : Name = ',trim(noms(iq)), &103 write(*,*) 'rad_correlatedk_recombination_init: found specie : Name = ',trim(noms(iq)), & 104 104 ' ; Predefined vmr=', is_recomb_qset(iq), & 105 105 ' ; On-the-fly=', is_recomb_qotf(iq) … … 142 142 ! Summary 143 143 write(*,*) 144 write(*,*) ' ini_recombin: Total species found for corrk recombination =', nrecomb_tot144 write(*,*) 'rad_correlatedk_recombination_init: Total species found for corrk recombination =', nrecomb_tot 145 145 146 146 if (corrk_recombin) then 147 147 if (use_premix) then 148 write(*,*) ' ini_recombin: .. Total radiative species matching total species for recombination...'149 write(*,*) ' ini_recombin: .. Any pre-mixed set of opacities will be ignored.'148 write(*,*) 'rad_correlatedk_recombination_init: .. Total radiative species matching total species for recombination...' 149 write(*,*) 'rad_correlatedk_recombination_init: .. Any pre-mixed set of opacities will be ignored.' 150 150 else 151 write(*,*) ' ini_recombin: .. Found less species to recombine than total radiative species..'152 write(*,*) ' ini_recombin: .. Recombination will occur ontop of premix set of opacities'151 write(*,*) 'rad_correlatedk_recombination_init: .. Found less species to recombine than total radiative species..' 152 write(*,*) 'rad_correlatedk_recombination_init: .. Recombination will occur ontop of premix set of opacities' 153 153 endif 154 154 else 155 write(*,*) ' ini_recombin: .. No species found for recombination, I will use premix set only.'155 write(*,*) 'rad_correlatedk_recombination_init: .. No species found for recombination, I will use premix set only.' 156 156 endif 157 157 write(*,*) 158 158 159 END SUBROUTINE ini_recombin159 END SUBROUTINE rad_correlatedk_recombination_init 160 160 161 161 162 162 163 SUBROUTINE su_recombin163 SUBROUTINE rad_correlatedk_recombination_setup 164 164 USE radinc_h 165 165 USE radcommon_h, only: gweight, gasi, gasv … … 178 178 IF(.NOT. ALLOCATED(wtwospec)) ALLOCATE(wtwospec(L_NGAUSS*L_NGAUSS)) 179 179 180 ! Init. for r ecombin_corrkfirstcall180 ! Init. for rad_correlatedk_online_recombination firstcall 181 181 permut_idx = (/(i, i=1,L_NGAUSS*L_NGAUSS)/) 182 182 … … 221 221 gasv_recomb(:,:,:,:,:) = gasv(:,:,1:L_REFVAR,:,:) ! non-zero init (=kappa_vi) 222 222 223 END SUBROUTINE su_recombin224 225 226 227 SUBROUTINE call_recombin(igrid,nlayer,pq,pplay,pt,qvar,tmid,pmid)223 END SUBROUTINE rad_correlatedk_recombination_setup 224 225 226 227 SUBROUTINE rad_correlatedk_recombination_main(igrid,nlayer,pq,pplay,pt,qvar,tmid,pmid) 228 228 229 229 USE comcstfi_mod, only: mugaz … … 283 283 if (is_recomb_qset(rcb2tot_idx(iq))==0 .and. is_recomb_qotf(rcb2tot_idx(iq))==0) then 284 284 print*, 'Recombining tracer ', noms(rcb2tot_idx(iq)),' requires an input profile, this is not implemented yet !!' 285 call abort_physic(' call_recombin','Missing implementation',1)285 call abort_physic('rad_correlatedk_recombination_main','Missing implementation',1) 286 286 ! Read pqr(:,iq) 287 287 endif … … 289 289 290 290 ! Recombine for all T-P-Q as we do it only once for all. 291 call r ecombin_corrk_ini(pqr)291 call rad_correlatedk_online_recombination_init(pqr) 292 292 ELSE 293 293 all_otf=.true. … … 304 304 ! calculate a gasi/v_recomb variable on the reference corrk-k T,P,X grid (only for T,P,X values 305 305 ! who match the atmospheric conditions) which is then processed as a standard pre-mix in 306 ! optci/v routines, but updated every time tracers on the ref P grid have varied > 1%.306 ! rad_correlatedk_opacities_thermal/v routines, but updated every time tracers on the ref P grid have varied > 1%. 307 307 308 308 ! Extract tracers for species which are recombined on-the-fly … … 341 341 ! The following useptx is a trick to call recombine only for the reference T-P-X 342 342 ! reference grid points that are useful given the temperature range (and variable specie amount) at a given altitude 343 ! (cf optci/optcvroutines where we interpolate corrk calling tpindex)343 ! (cf rad_correlatedk_opacities_thermal/rad_correlatedk_opacities_stellar routines where we interpolate corrk calling tpindex) 344 344 ! It saves a looot of time - JVO 18 345 345 … … 350 350 351 351 if (.not.all_otf) then 352 call r ecombin_corrk_mix(igrid,pqr,useptx)352 call rad_correlatedk_online_recombination_mix(igrid,pqr,useptx) 353 353 else 354 354 if (nrecomb_qotf.gt.1) then 355 call r ecombin_corrk_mix_allotf(igrid,pqr,useptx)355 call rad_correlatedk_online_recombination_mix_allotf(igrid,pqr,useptx) 356 356 else 357 357 do ix=1,L_REFVAR … … 368 368 endif 369 369 370 END SUBROUTINE call_recombin371 372 SUBROUTINE r ecombin_corrk_ini(pqr)370 END SUBROUTINE rad_correlatedk_recombination_main 371 372 SUBROUTINE rad_correlatedk_online_recombination_init(pqr) 373 373 374 374 USE radinc_h … … 587 587 enddo ! ip=1,L_REFVAR 588 588 589 END SUBROUTINE r ecombin_corrk_ini590 591 SUBROUTINE r ecombin_corrk_mix(igrid,pqr,useptx)589 END SUBROUTINE rad_correlatedk_online_recombination_init 590 591 SUBROUTINE rad_correlatedk_online_recombination_mix(igrid,pqr,useptx) 592 592 593 593 USE radinc_h … … 808 808 enddo ! ip=1,L_REFVAR 809 809 810 END SUBROUTINE r ecombin_corrk_mix811 812 SUBROUTINE r ecombin_corrk_mix_allotf(igrid,pqr,useptx)810 END SUBROUTINE rad_correlatedk_online_recombination_mix 811 812 SUBROUTINE rad_correlatedk_online_recombination_mix_allotf(igrid,pqr,useptx) 813 813 814 814 USE radinc_h … … 1027 1027 enddo ! ip=1,L_REFVAR 1028 1028 1029 END SUBROUTINE r ecombin_corrk_mix_allotf1030 1031 END MODULE r ecombin_corrk_mod1032 1029 END SUBROUTINE rad_correlatedk_online_recombination_mix_allotf 1030 1031 END MODULE rad_correlatedk_online_recombination_mod 1032 -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_opacities_stellar.F90
r4076 r4077 1 MODULE optcv_mod1 MODULE rad_correlatedk_opacities_stellar_mod 2 2 3 3 IMPLICIT NONE … … 5 5 CONTAINS 6 6 7 SUBROUTINE OPTCV(DTAUV,TAUV,TAUCUMV,PLEV, &7 SUBROUTINE rad_correlatedk_opacities_stellar(DTAUV,TAUV,TAUCUMV,PLEV, & 8 8 QXVAER,QSVAER,GVAER,WBARV,COSBV, & 9 9 TAUAERO,TMID,PMID,TAUGSURF,QVAR,MUVAR,FRACVAR) … … 16 16 use callkeys_mod, only: kastprof,continuum,graybody,callgasvis,varspec, & 17 17 rayleigh 18 use r ecombin_corrk_mod, only: corrk_recombin, gasv_recomb18 use rad_correlatedk_online_recombination_mod, only: corrk_recombin, gasv_recomb 19 19 use tpindex_mod, only: tpindex 20 use interpolate_continuum_mod, only: interpolate_continuum21 use calc_rayleigh_mod, only: calc_rayleigh20 use rad_correlatedk_continuum_interpolation_mod, only: rad_correlatedk_continuum_interpolation 21 use rad_correlatedk_rayleigh_scattering_opacity_mod, only: rad_correlatedk_rayleigh_scattering_opacity 22 22 23 23 implicit none … … 138 138 else 139 139 dz(k) = dpr(k)*R*TMID(K)/(glat_ig*PMID(K))*mugaz/muvar(k) 140 U(k) = Cmk*DPR(k)*mugaz/muvar(k) ! only Cmk line in optci.F140 U(k) = Cmk*DPR(k)*mugaz/muvar(k) ! only Cmk line in rad_correlatedk_opacities_thermal.F 141 141 !JL13 the mugaz/muvar factor takes into account water meanmolecular weight if water is present 142 142 endif … … 154 154 ! but visible does not handle very well diffusion in first layer. 155 155 ! The tauaero and tauray are thus set to 0 (a small value for rayleigh because the code crashes otherwise) 156 ! in the 4 first semilayers in optcv, but not optci.156 ! in the 4 first semilayers in rad_correlatedk_opacities_stellar, but not rad_correlatedk_opacities_thermal. 157 157 ! This solves random variations of the sw heating at the model top. 158 158 do iaer=1,naerkind … … 170 170 171 171 if(rayleigh) then 172 call calc_rayleigh(QVAR,MUVAR,PMID,TMID,TAURAY)172 call rad_correlatedk_rayleigh_scattering_opacity(QVAR,MUVAR,PMID,TMID,TAURAY) 173 173 else 174 print*,' setspv: No Rayleigh scattering, check for NaN in output!'174 print*,'rad_correlatedk_init_stellar: No Rayleigh scattering, check for NaN in output!' 175 175 do NW=1,L_NSPECTV 176 176 TAURAY(:,NW) = 1E-16 … … 243 243 ((igas .eq. igas_CO2) .and. (jgas .eq. igas_CH4)) ) then 244 244 245 call interpolate_continuum('',igas,jgas,'VI',nw,T_cont,p_cont,p_cross,dtemp,.false.)245 call rad_correlatedk_continuum_interpolation('',igas,jgas,'VI',nw,T_cont,p_cont,p_cross,dtemp,.false.) 246 246 247 247 endif … … 268 268 269 269 ! JVO 2017 : added tmpk because the repeated calls to gasi/v increased dramatically 270 ! the execution time of optci/v -> ~ factor 2 on the whole radiative270 ! the execution time of rad_correlatedk_opacities_thermal/v -> ~ factor 2 on the whole radiative 271 271 ! transfer on the tested simulations ! 272 272 … … 334 334 !JL18 It seems to be good to have aerosols in the first "radiative layer" of the gcm in the IR 335 335 ! but not in the visible 336 ! The tauaero is thus set to 0 in the 4 first semilayers in optcv, but not optci.336 ! The tauaero is thus set to 0 in the 4 first semilayers in rad_correlatedk_opacities_stellar, but not rad_correlatedk_opacities_thermal. 337 337 ! This solves random variations of the sw heating at the model top. 338 338 do iaer=1,naerkind … … 407 407 408 408 409 end subroutine optcv410 411 END MODULE optcv_mod409 end subroutine rad_correlatedk_opacities_stellar 410 411 END MODULE rad_correlatedk_opacities_stellar_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_opacities_thermal.F90
r4076 r4077 1 MODULE optci_mod1 MODULE rad_correlatedk_opacities_thermal_mod 2 2 3 3 IMPLICIT NONE … … 5 5 CONTAINS 6 6 7 subroutine optci(PLEV,TLEV,DTAUI,TAUCUMI, &7 subroutine rad_correlatedk_opacities_thermal(PLEV,TLEV,DTAUI,TAUCUMI, & 8 8 QXIAER,QSIAER,GIAER,COSBI,WBARI,TAUAERO, & 9 9 TMID,PMID,TAUGSURF,QVAR,MUVAR,FRACVAR) … … 16 16 use comcstfi_mod, only: g, r, mugaz 17 17 use callkeys_mod, only: kastprof,continuum,graybody,varspec 18 use r ecombin_corrk_mod, only: corrk_recombin, gasi_recomb18 use rad_correlatedk_online_recombination_mod, only: corrk_recombin, gasi_recomb 19 19 use tpindex_mod, only: tpindex 20 use interpolate_continuum_mod, only: interpolate_continuum20 use rad_correlatedk_continuum_interpolation_mod, only: rad_correlatedk_continuum_interpolation 21 21 22 22 implicit none … … 150 150 else 151 151 dz(k) = dpr(k)*R*TMID(K)/(glat_ig*PMID(K))*mugaz/muvar(k) 152 U(k) = Cmk*DPR(k)*mugaz/muvar(k) ! only Cmk line in optci.F152 U(k) = Cmk*DPR(k)*mugaz/muvar(k) ! only Cmk line in rad_correlatedk_opacities_thermal.F 153 153 !JL13 the mugaz/muvar factor takes into account water meanmolecular weight if water is present 154 154 endif … … 222 222 ((igas .eq. igas_CO2) .and. (jgas .eq. igas_CH4)) ) then 223 223 224 call interpolate_continuum('',igas,jgas,'IR',nw,T_cont,p_cont,p_cross,dtemp,.false.)224 call rad_correlatedk_continuum_interpolation('',igas,jgas,'IR',nw,T_cont,p_cont,p_cross,dtemp,.false.) 225 225 226 226 endif … … 247 247 248 248 ! JVO 2017 : added tmpk because the repeated calls to gasi/v increased dramatically 249 ! the execution time of optci/v -> ~ factor 2 on the whole radiative249 ! the execution time of rad_correlatedk_opacities_thermal/v -> ~ factor 2 on the whole radiative 250 250 ! transfer on the tested simulations ! 251 251 … … 457 457 ! call abort 458 458 459 end subroutine optci460 461 END MODULE optci_mod462 459 end subroutine rad_correlatedk_opacities_thermal 460 461 END MODULE rad_correlatedk_opacities_thermal_mod 462 -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_rayleigh_scattering_opacity.F90
r4076 r4077 1 module calc_rayleigh_mod1 module rad_correlatedk_rayleigh_scattering_opacity_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 subroutine calc_rayleigh(qvar,muvar,PMID,TMID,tauray)7 subroutine rad_correlatedk_rayleigh_scattering_opacity(qvar,muvar,PMID,TMID,tauray) 8 8 9 9 !================================================================== … … 24 24 ! Called by 25 25 ! --------- 26 ! setspv.F26 ! rad_correlatedk_init_stellar.F 27 27 ! 28 28 ! Calls … … 97 97 ! mu is the mean molecular weight 98 98 ! x_i is the mass fraction of the ith gas 99 ! The pressure P dependence is calculated in optcv.F9099 ! The pressure P dependence is calculated in rad_correlatedk_opacities_stellar.F90 100 100 101 101 if(firstcall) then … … 325 325 enddo !ngasmx 326 326 327 call blackl(dble(wl*1e-6),dble(tstellar),df)327 call rad_blackbody_planck_law_wavelength(dble(wl*1e-6),dble(tstellar),df) 328 328 df=df*bwidth/Nfine 329 329 tauwei=tauwei+df … … 337 337 338 338 339 end subroutine calc_rayleigh340 341 end module calc_rayleigh_mod339 end subroutine rad_correlatedk_rayleigh_scattering_opacity 340 341 end module rad_correlatedk_rayleigh_scattering_opacity_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_read_opacity_tables.F90
r4076 r4077 1 subroutine sugas_corrk1 subroutine rad_correlatedk_read_opacity_tables 2 2 3 3 !================================================================== … … 36 36 continuum 37 37 use tracer_h, only : nqtot, moderntracdef, is_recomb, noms 38 use r ecombin_corrk_mod, only: su_recombin, &38 use rad_correlatedk_online_recombination_mod, only: rad_correlatedk_recombination_setup, & 39 39 corrk_recombin, use_premix, nrecomb_tot, rcb2tot_idx 40 use interpolate_continuum_mod, only: interpolate_continuum40 use rad_correlatedk_continuum_interpolation_mod, only: rad_correlatedk_continuum_interpolation 41 41 implicit none 42 42 … … 77 77 if(.not.file_ok) then 78 78 write(*,*)'The file ',TRIM(file_path) 79 write(*,*)'was not found by sugas_corrk.F90, exiting.'79 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90, exiting.' 80 80 write(*,*)'Check that your path to datagcm:',trim(datadir) 81 81 write(*,*)' is correct. You can change it in callphys.def with:' 82 82 write(*,*)' datadir = /absolute/path/to/datagcm' 83 83 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 84 call abort_physic(" sugas_corrk", "Unable to read file", 1)84 call abort_physic("rad_correlatedk_read_opacity_tables ", "Unable to read file", 1) 85 85 endif 86 86 … … 96 96 print*,'Number of gases in radiative transfer data (',ngas,') does not', & 97 97 'match that in gases.def (',ngasmx,'), exiting.' 98 call abort_physic(" sugas_corrk", "Number of gases in radiative transfer data does not match that in gases.def", 1)98 call abort_physic("rad_correlatedk_read_opacity_tables ", "Number of gases in radiative transfer data does not match that in gases.def", 1) 99 99 endif 100 100 endif … … 104 104 corrkdir(1:LEN_TRIM(corrkdir)), & 105 105 '] has no variable species, exiting.' 106 call abort_physic(" sugas_corrk", "You have varactive/fixed=.true. but the database has no variable species",1)106 call abort_physic("rad_correlatedk_read_opacity_tables ", "You have varactive/fixed=.true. but the database has no variable species",1) 107 107 elseif(ngas.gt.5 .or. ngas.lt.1)then 108 108 print*,ngas,' species in database [', & 109 109 corrkdir(1:LEN_TRIM(corrkdir)), & 110 110 '], radiative code cannot handle this.' 111 call abort_physic(" sugas_corrk", "No gas or too many gases for radiative code", 1)111 call abort_physic("rad_correlatedk_read_opacity_tables ", "No gas or too many gases for radiative code", 1) 112 112 endif 113 113 … … 135 135 corrkdir(1:LEN_TRIM(corrkdir)), & 136 136 '] has a variable species.' 137 call abort_physic(" sugas_corrk", "You have varactive and varfixed=.false. and the database has a variable species",1)137 call abort_physic("rad_correlatedk_read_opacity_tables ", "You have varactive and varfixed=.false. and the database has a variable species",1) 138 138 endif 139 139 … … 149 149 'match that in gases.def (',trim(gnom(igas)),'), exiting. You should compare ', & 150 150 'gases.def with Q.dat in your radiative transfer directory.' 151 call abort_physic(" sugas_corrk", "Name of a gas in radiative transfer data does not match that in gases.def",1)151 call abort_physic("rad_correlatedk_read_opacity_tables ", "Name of a gas in radiative transfer data does not match that in gases.def",1) 152 152 endif 153 153 enddo … … 177 177 if(.not.file_ok) then 178 178 write(*,*)'The file ',TRIM(file_path) 179 write(*,*)'was not found by sugas_corrk.F90, exiting.'179 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90, exiting.' 180 180 write(*,*)'Check that your path to datagcm:',trim(datadir) 181 181 write(*,*)' is correct. You can change it in callphys.def with:' 182 182 write(*,*)' datadir = /absolute/path/to/datagcm' 183 183 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 184 call abort_physic(" sugas_corrk", "Unable to read file", 1)184 call abort_physic("rad_correlatedk_read_opacity_tables ", "Unable to read file", 1) 185 185 endif 186 186 … … 213 213 if(.not.file_ok) then 214 214 write(*,*)'The file ',TRIM(file_path) 215 write(*,*)'was not found by sugas_corrk.F90, exiting.'215 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90, exiting.' 216 216 write(*,*)'Check that your path to datagcm:',trim(datadir) 217 217 write(*,*)' is correct. You can change it in callphys.def with:' 218 218 write(*,*)' datadir = /absolute/path/to/datagcm' 219 219 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 220 call abort_physic(" sugas_corrk", "Unable to read file", 1)220 call abort_physic("rad_correlatedk_read_opacity_tables ", "Unable to read file", 1) 221 221 endif 222 222 … … 259 259 if(.not.file_ok) then 260 260 write(*,*)'The file ',TRIM(file_path) 261 write(*,*)'was not found by sugas_corrk.F90, exiting.'261 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90, exiting.' 262 262 write(*,*)'Check that your path to datagcm:',trim(datadir) 263 263 write(*,*)' is correct. You can change it in callphys.def with:' 264 264 write(*,*)' datadir = /absolute/path/to/datagcm' 265 265 write(*,*)'Also check that the corrkdir you chose in callphys.def exists.' 266 call abort_physic(" sugas_corrk", "Unable to read file",1)266 call abort_physic("rad_correlatedk_read_opacity_tables ", "Unable to read file",1) 267 267 endif 268 268 … … 379 379 if(.not.file_ok) then 380 380 write(*,*)'The file ',TRIM(file_path) 381 write(*,*)'was not found by sugas_corrk.F90.'381 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90.' 382 382 write(*,*)'Are you sure you have absorption data for these bands?' 383 call abort_physic(" sugas_corrk", "No absorption data found", 1)383 call abort_physic("rad_correlatedk_read_opacity_tables ", "No absorption data found", 1) 384 384 endif 385 385 … … 403 403 if(.not.file_ok) then 404 404 write(*,*)'The file ',TRIM(file_path) 405 write(*,*)'was not found by sugas_corrk.F90.'405 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90.' 406 406 write(*,*)'Are you sure you have absorption data for this specie at these bands?' 407 call abort_physic(" sugas_corrk", "No absorption data found", 1)407 call abort_physic("rad_correlatedk_read_opacity_tables ", "No absorption data found", 1) 408 408 endif 409 409 … … 449 449 if(.not.file_ok) then 450 450 write(*,*)'The file ',TRIM(file_path) 451 write(*,*)'was not found by sugas_corrk.F90.'451 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90.' 452 452 write(*,*)'Are you sure you have absorption data for these bands?' 453 call abort_physic(" sugas_corrk", "No absorption data found", 1)453 call abort_physic("rad_correlatedk_read_opacity_tables ", "No absorption data found", 1) 454 454 endif 455 455 … … 516 516 if(.not.file_ok) then 517 517 write(*,*)'The file ',TRIM(file_path) 518 write(*,*)'was not found by sugas_corrk.F90.'518 write(*,*)'was not found by rad_correlatedk_read_opacity_tables .F90.' 519 519 write(*,*)'Are you sure you have absorption data for this specie at these bands?' 520 call abort_physic(" sugas_corrk", "No absorption data found", 1)520 call abort_physic("rad_correlatedk_read_opacity_tables ", "No absorption data found", 1) 521 521 endif 522 522 !$OMP MASTER … … 710 710 711 711 ! Allocate and initialise arrays for corrk_recombin 712 if (corrk_recombin) call su_recombin712 if (corrk_recombin) call rad_correlatedk_recombination_setup 713 713 714 714 !======================================================================= … … 721 721 file_id='/continuum_data/' // 'N2-N2_continuum_70-500K_2025.dat' 722 722 file_path=TRIM(datadir)//TRIM(file_id) 723 call interpolate_continuum(file_path,igas_N2,igas_N2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)723 call rad_correlatedk_continuum_interpolation(file_path,igas_N2,igas_N2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 724 724 do jgas=1,ngasmx 725 725 if (jgas .eq. igas_H2) then 726 726 file_id='/continuum_data/' // 'H2-N2_continuum_40-600K_2025.dat' 727 727 file_path=TRIM(datadir)//TRIM(file_id) 728 call interpolate_continuum(file_path,igas_N2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)728 call rad_correlatedk_continuum_interpolation(file_path,igas_N2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 729 729 elseif (jgas .eq. igas_O2) then 730 730 file_id='/continuum_data/' // 'O2-N2_continuum_100-500K_2025.dat' 731 731 file_path=TRIM(datadir)//TRIM(file_id) 732 call interpolate_continuum(file_path,igas_N2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)732 call rad_correlatedk_continuum_interpolation(file_path,igas_N2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 733 733 elseif (jgas .eq. igas_CH4) then 734 734 file_id='/continuum_data/' // 'CH4-N2_continuum_40-600K_2025.dat' 735 735 file_path=TRIM(datadir)//TRIM(file_id) 736 call interpolate_continuum(file_path,igas_N2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)736 call rad_correlatedk_continuum_interpolation(file_path,igas_N2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 737 737 endif 738 738 enddo … … 740 740 file_id='/continuum_data/' // 'O2-O2_continuum_100-400K_2025.dat' 741 741 file_path=TRIM(datadir)//TRIM(file_id) 742 call interpolate_continuum(file_path,igas_O2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)742 call rad_correlatedk_continuum_interpolation(file_path,igas_O2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 743 743 do jgas=1,ngasmx 744 744 if (jgas .eq. igas_CO2) then 745 745 file_id='/continuum_data/' // 'CO2-O2_continuum_150-600K_2025.dat' 746 746 file_path=TRIM(datadir)//TRIM(file_id) 747 call interpolate_continuum(file_path,igas_CO2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)747 call rad_correlatedk_continuum_interpolation(file_path,igas_CO2,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 748 748 endif 749 749 enddo … … 751 751 file_id='/continuum_data/' // 'H2-H2_continuum_40-7000K_2025.dat' 752 752 file_path=TRIM(datadir)//TRIM(file_id) 753 call interpolate_continuum(file_path,igas_H2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)753 call rad_correlatedk_continuum_interpolation(file_path,igas_H2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 754 754 do jgas=1,ngasmx 755 755 if (jgas .eq. igas_CH4) then 756 756 file_id='/continuum_data/' // 'H2-CH4_continuum_40-600K_2025.dat' 757 757 file_path=TRIM(datadir)//TRIM(file_id) 758 call interpolate_continuum(file_path,igas_H2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)758 call rad_correlatedk_continuum_interpolation(file_path,igas_H2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 759 759 elseif (jgas .eq. igas_He) then 760 760 file_id='/continuum_data/' // 'H2-He_continuum_40-5500K_2025.dat' 761 761 file_path=TRIM(datadir)//TRIM(file_id) 762 call interpolate_continuum(file_path,igas_H2,igas_He,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)762 call rad_correlatedk_continuum_interpolation(file_path,igas_H2,igas_He,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 763 763 endif 764 764 enddo … … 766 766 file_id='/continuum_data/' // 'CH4-CH4_continuum_40-500K_2025.dat' 767 767 file_path=TRIM(datadir)//TRIM(file_id) 768 call interpolate_continuum(file_path,igas_CH4,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)768 call rad_correlatedk_continuum_interpolation(file_path,igas_CH4,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 769 769 elseif (igas .eq. igas_H2O) then 770 770 file_id='/continuum_data/' // 'H2O-H2O_continuum_100-2000K_2025.dat' 771 771 file_path=TRIM(datadir)//TRIM(file_id) 772 call interpolate_continuum(file_path,igas_H2O,igas_H2O,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)772 call rad_correlatedk_continuum_interpolation(file_path,igas_H2O,igas_H2O,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 773 773 do jgas=1,ngasmx 774 774 if (jgas .eq. igas_N2) then 775 775 file_id='/continuum_data/' // 'H2O-N2_continuum_100-2000K_2025.dat' 776 776 file_path=TRIM(datadir)//TRIM(file_id) 777 call interpolate_continuum(file_path,igas_H2O,igas_N2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)777 call rad_correlatedk_continuum_interpolation(file_path,igas_H2O,igas_N2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 778 778 elseif (jgas .eq. igas_O2) then 779 779 file_id='/continuum_data/' // 'H2O-O2_continuum_100-2000K_2025.dat' 780 780 file_path=TRIM(datadir)//TRIM(file_id) 781 call interpolate_continuum(file_path,igas_H2O,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)781 call rad_correlatedk_continuum_interpolation(file_path,igas_H2O,igas_O2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 782 782 elseif (jgas .eq. igas_CO2) then 783 783 file_id='/continuum_data/' // 'H2O-CO2_continuum_100-800K_2025.dat' 784 784 file_path=TRIM(datadir)//TRIM(file_id) 785 call interpolate_continuum(file_path,igas_H2O,igas_CO2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)785 call rad_correlatedk_continuum_interpolation(file_path,igas_H2O,igas_CO2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 786 786 endif 787 787 enddo … … 789 789 file_id='/continuum_data/' // 'CO2-CO2_continuum_100-800K_2025.dat' 790 790 file_path=TRIM(datadir)//TRIM(file_id) 791 call interpolate_continuum(file_path,igas_CO2,igas_CO2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)791 call rad_correlatedk_continuum_interpolation(file_path,igas_CO2,igas_CO2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 792 792 do jgas=1,ngasmx 793 793 if (jgas .eq. igas_H2) then 794 794 file_id='/continuum_data/' // 'CO2-H2_continuum_100-800K_2025.dat' 795 795 file_path=TRIM(datadir)//TRIM(file_id) 796 call interpolate_continuum(file_path,igas_CO2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)796 call rad_correlatedk_continuum_interpolation(file_path,igas_CO2,igas_H2,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 797 797 elseif (jgas .eq. igas_CH4) then 798 798 file_id='/continuum_data/' // 'CO2-CH4_continuum_100-800K_2025.dat' 799 799 file_path=TRIM(datadir)//TRIM(file_id) 800 call interpolate_continuum(file_path,igas_CO2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.)800 call rad_correlatedk_continuum_interpolation(file_path,igas_CO2,igas_CH4,'IR',1,300.D+0,10000.D+0,20000.D+0,testcont,.true.) 801 801 endif 802 802 enddo … … 822 822 !$OMP BARRIER 823 823 824 end subroutine sugas_corrk824 end subroutine rad_correlatedk_read_opacity_tables -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_correlatedk_stellar_spectrum.F90
r4076 r4077 1 module ave_stelspec_mod1 module rad_correlatedk_stellar_spectrum_mod 2 2 3 3 implicit none … … 5 5 contains 6 6 7 subroutine ave_stelspec(STELLAR)7 subroutine rad_correlatedk_stellar_spectrum (STELLAR) 8 8 9 9 !================================================================== … … 22 22 ! Called by 23 23 ! --------- 24 ! setspv.F24 ! rad_correlatedk_init_stellar.F 25 25 ! 26 26 ! Calls … … 71 71 do ifine=1,Nfineband 72 72 lam_temp=lamm+(lamp-lamm)*(ifine-1.)/(Nfineband) 73 call blackl(dble(lam_temp*1e-6),dble(tstellar),stel_temp)73 call rad_blackbody_planck_law_wavelength(dble(lam_temp*1e-6),dble(tstellar),stel_temp) 74 74 STELLAR(band)=STELLAR(band)+stel_temp*dl 75 75 enddo … … 86 86 write(*,*)'Error: tstellar (effective stellar temperature) needs to be specified' 87 87 write(*,*)'in callphys.def: tstellar=...' 88 call abort_physic(" ave_stelspec", "tstellar needs to be specified",1)88 call abort_physic("rad_correlatedk_stellar_spectrum", "tstellar needs to be specified",1) 89 89 end if 90 90 … … 121 121 write(*,*)'available stellar spectra here : ' 122 122 write(*,*)'https://web.lmd.jussieu.fr/~lmdz/planets/generic/datagcm/stellar_spectra/' 123 call abort_physic(" ave_stelspec", "Unable to read stellar flux file", 1)123 call abort_physic("rad_correlatedk_stellar_spectrum", "Unable to read stellar flux file", 1) 124 124 end if 125 125 … … 174 174 endif !stelbbody 175 175 176 end subroutine ave_stelspec176 end subroutine rad_correlatedk_stellar_spectrum 177 177 178 end module ave_stelspec_mod178 end module rad_correlatedk_stellar_spectrum_mod -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_newton_cooling.F90
r4076 r4077 1 subroutine newtrelax(ngrid,nlayer,mu0,sinlat,popsk,temp,pplay,pplev,dtrad,firstcall)1 subroutine rad_netwon_cooling(ngrid,nlayer,mu0,sinlat,popsk,temp,pplay,pplev,dtrad,firstcall) 2 2 3 3 use comcstfi_mod, only: rcp, pi … … 126 126 !call writediagfi(ngrid,'ThetaZ','stellar zenith angle','deg',2,mu0) 127 127 128 end subroutine newtrelax128 end subroutine rad_netwon_cooling -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_newton_cooling_hot_jupiter.F90
r4076 r4077 1 module newton_cooling_hotJ1 module rad_netwon_cooling_hot_jupiter 2 2 3 3 !========================================================================================== … … 10 10 ! 11 11 ! We aim at having a generic code but you never know, it might need improving at some point. 12 ! The current (at time of writing) newtrelax.F90 routine is hardcoded for telluric temperate planets and untested.12 ! The current (at time of writing) rad_netwon_cooling.F90 routine is hardcoded for telluric temperate planets and untested. 13 13 ! Thus, we don't use it and use this one instead. 14 14 ! … … 30 30 contains 31 31 32 subroutine newtcool_MOCHA(ngrid,nlayer,coslon,coslat,temp,pplay,firstcall,lastcall,dtrad)32 subroutine rad_newton_cooling_MOCHA_intercomparison(ngrid,nlayer,coslon,coslat,temp,pplay,firstcall,lastcall,dtrad) 33 33 34 34 ! use callkeys_mod, only: planetary_suffix ! this is to know which profiles to load for the T0, the delta Teq and the tau_rad … … 131 131 endif 132 132 133 end subroutine newtcool_MOCHA133 end subroutine rad_newton_cooling_MOCHA_intercomparison 134 134 135 135 subroutine read_input(nlayer,filename, field) … … 163 163 open(401,form='formatted',status='old',file=trim(filename) ,iostat=ierr) 164 164 if (ierr /=0) then 165 print*,"Problem in newton_cooling_hotJ.F90"165 print*,"Problem in rad_netwon_cooling_hot_jupiter.F90" 166 166 print*,"I have an issue opening file ",trim(filename) 167 167 call abort_physic("newton_cooling_hot_J", "Unable to read input file", 1) … … 180 180 end subroutine read_input 181 181 182 end module newton_cooling_hotJ182 end module rad_netwon_cooling_hot_jupiter -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_ring_shadowing.F90
r4076 r4077 1 subroutine call_rings(ngrid, ptime, pday, diurnal)1 subroutine rad_ring_shadowing(ngrid, ptime, pday, diurnal) 2 2 ! A subroutine to compute the day fraction in case of rings shadowing. 3 3 … … 41 41 do m=1, nb_hours 42 42 ptime_day = m*pas 43 call stellarlong(pday+ptime_day,tmp_zls)44 call orbite(tmp_zls,tmp_dist_star,tmp_declin,tmp_right_ascen)43 call ephemeris_stellar_longitude(pday+ptime_day,tmp_zls) 44 call ephemeris_orbit(tmp_zls,tmp_dist_star,tmp_declin,tmp_right_ascen) 45 45 46 46 ztim1=SIN(tmp_declin) … … 48 48 ztim3=-COS(tmp_declin)*SIN(2.*pi*(pday+ptime_day-.5)) 49 49 50 call stelang(ngrid,sinlon,coslon,sinlat,coslat, &50 call ephemeris_stellar_angle(ngrid,sinlon,coslon,sinlat,coslat, & 51 51 ztim1,ztim2,ztim3,tmp_mu0,tmp_fract, flatten) 52 call rings(ngrid, tmp_declin, ptime_day, rad, flatten, eclipse)52 call saturn_rings(ngrid, tmp_declin, ptime_day, rad, flatten, eclipse) 53 53 fract(:) = fract(:) + (1.-eclipse(:))*tmp_fract(:) !! fract takes into account the rings shadow and the day/night alternation 54 54 … … 61 61 62 62 else ! instant insolation is weighted by the rings shadow 63 call rings(ngrid, declin, ptime, rad, 0., eclipse)63 call saturn_rings(ngrid, declin, ptime, rad, 0., eclipse) 64 64 fract(:) = fract(:) * (1.-eclipse) 65 65 endif … … 67 67 IF (ALLOCATED(eclipse)) DEALLOCATE(eclipse) 68 68 69 end subroutine call_rings 69 end subroutine rad_ring_shadowing 70 71 72 SUBROUTINE saturn_rings(ngrid, declin, ptime, rad, flat, eclipse) 73 ! Calculates Saturn's rings shadowing 74 ! Includes rings opacities measured by Cassini/UVIS 75 ! Authors: M. Sylvestre, M. Capderou, S. Guerlet, A. Spiga 76 77 use comdiurn_h, only: sinlat, sinlon, coslat, coslon 78 use geometry_mod, only: latitude ! (rad) 79 80 implicit none 81 82 INTEGER, INTENT(IN) :: ngrid ! horizontal grid dimension 83 REAL, INTENT(IN) :: declin ! latitude of the subsolar point 84 REAL, INTENT(IN) :: ptime ! UTC time in sol fraction : ptime=0.5 at noon 85 REAL, INTENT(IN) :: rad ! equatorial radius of the planet 86 REAL, INTENT(IN) :: flat ! flattening of the planet 87 REAL, DIMENSION(ngrid), INTENT(OUT) :: eclipse ! absorption of the light by the rings 88 89 REAL :: rpol ! polar radius of the planet 90 REAL :: e ! shape excentricity of the planet : (1-e*e) = (1-f)*(1-f) 91 INTEGER, PARAMETER :: nb_a = 4 ! number of subdivisions of the A ring 92 INTEGER, PARAMETER :: nb_b = 3 ! number of subdivisions of the B ring 93 INTEGER, PARAMETER :: nb_c = 3 ! number of subdivisions of the C ring 94 INTEGER, PARAMETER :: nb_ca = 2 ! number of subdivisions in the Cassini division 95 INTEGER :: i 96 97 ! arrays for the rings. TBD: dynamical? 98 REAL, DIMENSION(nb_a) :: A_Rint ! internal radii of the subdivisions of the A ring 99 REAL, DIMENSION(nb_a) :: A_Rext ! external radii of the subdivisions of the A ring 100 REAL, DIMENSION(nb_b) :: B_Rint ! internal radii of the subdivisions of the B ring 101 REAL, DIMENSION(nb_b) :: B_Rext ! external radii of the subdivisions of the B ring 102 REAL, DIMENSION(nb_c) :: C_Rint ! internal radii of the subdivisions of the C ring 103 REAL, DIMENSION(nb_c) :: C_Rext ! external radii of the subdivisions of the C ring 104 REAL, DIMENSION(nb_ca) :: Ca_Rint ! internal radii of the subdivisions of the Cassini Division 105 REAL, DIMENSION(nb_ca) :: Ca_Rext ! external radii of the subdivisions of the Cassini Division 106 107 ! Opacities of the rings : for each one we can give different opacities for each part 108 REAL, DIMENSION(nb_a) :: tau_A ! opacity of the A ring 109 REAL, DIMENSION(nb_b) :: tau_B ! opacity of the B ring 110 REAL, DIMENSION(nb_c) :: tau_C ! opacity of the C ring 111 REAL, DIMENSION(nb_ca) :: tau_Ca ! opacity of the Cassini Division 112 113 ! Parameters used to calculate if a point is under a ring subdivision's shadow 114 REAL :: phi_S ! subsolar point longitude 115 REAL, PARAMETER :: pi=acos(-1.0) 116 REAL, DIMENSION(:), ALLOCATABLE:: x, y, z ! cartesian coordinates of the points on the planet 117 REAL :: xs, ys, zs ! cartesian coordinates of the points of the subsolar point 118 REAL, DIMENSION(:), ALLOCATABLE :: k 119 REAL, DIMENSION(:), ALLOCATABLE :: N ! parameter to compute cartesian coordinates on a ellipsoidal planet 120 REAL, DIMENSION(:), ALLOCATABLE :: r ! distance at which the incident ray of sun crosses the equatorial plane 121 ! measured from the center of the planet 122 REAL :: Ns ! (same for the subsolar point) 123 124 ! equinox --> no shadow (AS: why is this needed?) 125 if(declin .eq. 0.) then 126 eclipse(:) = 0. 127 return 128 endif 129 130 ! 1) INITIALIZATION 131 132 ! Generic 133 rpol = (1.- flat)*rad 134 e = sqrt(2*flat - flat**2) 135 ALLOCATE(x(ngrid)) 136 ALLOCATE(y(ngrid)) 137 ALLOCATE(z(ngrid)) 138 ALLOCATE(k(ngrid)) 139 ALLOCATE(N(ngrid)) 140 ALLOCATE(r(ngrid)) 141 eclipse(:) = 2000. 142 143 ! Model of the rings with Cassini/UVIS opacities 144 145 ! Size of the rings 146 A_Rint(1) = 2.03*rad 147 A_Rext(1) = 2.06*rad 148 A_Rint(2) = 2.06*rad 149 A_Rext(2) = 2.09*rad 150 A_Rint(3) = 2.09*rad 151 A_Rext(3) = 2.12*rad 152 A_Rint(4) = 2.12*rad 153 A_Rext(4) = 2.27*rad 154 155 B_Rint(1) = 1.53*rad 156 B_Rext(1) = 1.64*rad 157 B_Rint(2) = 1.64*rad 158 B_Rext(2) = 1.83*rad 159 B_Rint(3) = 1.83*rad 160 B_Rext(3) = 1.95*rad 161 162 C_Rint(1) = 1.24*rad 163 C_Rext(1) = 1.29*rad 164 C_Rint(2) = 1.29*rad 165 C_Rext(2) = 1.43*rad 166 C_Rint(3) = 1.43*rad 167 C_Rext(3) = 1.53*rad 168 169 Ca_Rint(1) = 1.95*rad 170 Ca_Rext(1) = 1.99*rad 171 Ca_Rint(2) = 1.99*rad 172 Ca_Rext(2) = 2.03*rad 173 174 175 ! Opacities of the rings 176 tau_A(1) = 1.24 177 tau_A(2) = 0.81 178 tau_A(3) = 0.67 179 tau_A(4) = 0.58 180 181 tau_B(1) = 1.29 182 tau_B(2) = 5.13 183 tau_B(3) = 2.84 184 185 tau_C(1) = 0.06 186 tau_C(2) = 0.10 187 tau_C(3) = 0.14 188 189 tau_Ca(1) = 0.06 190 tau_Ca(2) = 0.24 191 192 ! Convert to cartesian coordinates 193 N(:) = rad / sqrt(1-(e**2)*sinlat(:)**2) 194 x(:) = N(:)*coslat(:)*coslon(:) 195 y(:) = N(:)*coslat(:)*sinlon(:) 196 z(:) = N(:)*(1-e**2)*sinlat(:) 197 198 ! 2) LOCATION OF THE SUBSOLAR POINT 199 200 ! subsolar longitude is deduced from time fraction ptime 201 ! SG: the minus sign is important! ... otherwise subsolar point adopts a reverse rotation 202 phi_S = -(ptime - 0.5)*2.*pi 203 ! write(*,*) 'subsol point coords : ', declin*180./pi, phi_S*180./pi 204 205 ! subsolar latitude is declin (declination of the sun) 206 ! now convert in cartesian coordinates : 207 Ns = rad/sqrt(1-(e**2)*sin(declin)**2) 208 xs = Ns*cos(declin)*cos(phi_S) 209 ys = Ns*cos(declin)*sin(phi_S) 210 zs = Ns*(1-e**2)*sin(declin) 211 212 ! 3) WHERE DOES THE INCIDENT RAY OF SUN CROSS THE EQUATORIAL PLAN ? 213 214 k(:) = -z(:)/zs 215 r(:) = (k(:)*xs + x(:))**2 + (k(:)*ys + y(:))**2 216 r(:) = sqrt(r(:)) 217 218 ! 4) SO WHERE ARE THE SHADOW OF THESE RINGS ? 219 220 ! Summer hemisphere is not under the shadow of the rings 221 where(latitude(:)*declin .gt. 0.) 222 eclipse(:) = 1000. 223 end where 224 225 ! No shadow of the rings by night 226 where(x(:)*xs + y(:)*ys + z(:)*zs .lt. 0.) 227 eclipse(:) = 1000. 228 end where 229 230 ! if the incident rays of sun cross a ring, there is a shadow 231 do i=1, nb_A 232 where(r(:) .ge. A_Rint(i) .and. r(:) .le. A_Rext(i) .and. eclipse(:) .ne. 1000.) 233 eclipse(:) = 1. - exp(-tau_A(i)/abs(sin(declin))) 234 end where 235 end do 236 237 do i=1, nb_B 238 where(r(:) .ge. B_Rint(i) .and. r(:) .le. B_Rext(i) .and. eclipse(:) .ne. 1000.) 239 eclipse(:) = 1. - exp(-tau_B(i)/abs(sin(declin))) 240 end where 241 enddo 242 243 do i=1, nb_C 244 where(r(:) .ge. C_Rint(i) .and. r(:) .le. C_Rext(i) .and. eclipse(:) .ne. 1000.) 245 eclipse(:) = 1. - exp(-tau_C(i)/abs(sin(declin))) 246 end where 247 enddo 248 249 do i=1, nb_ca 250 where(r(:) .ge. Ca_Rint(i) .and. r(:) .le. Ca_Rext(i) .and. eclipse(:) .ne. 1000.) 251 eclipse(:) = 1. - exp(-tau_Ca(i)/abs(sin(declin))) 252 end where 253 enddo 254 255 ! At the other places and the excluded ones, eclipse is 0. 256 where(eclipse(:) .eq. 2000. .or. eclipse(:) .eq. 1000.) 257 eclipse(:) = 0. 258 end where 259 260 ! 5) CLEAN THE PLACE 261 DEALLOCATE(x) 262 DEALLOCATE(y) 263 DEALLOCATE(z) 264 DEALLOCATE(k) 265 DEALLOCATE(N) 266 DEALLOCATE(r) 267 268 END SUBROUTINE saturn_rings -
trunk/LMDZ.GENERIC/libf/phygeneric/rad_tridiagonal_matrix_solver.F
r4076 r4077 1 SUBROUTINE DSOLVER(NL,GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4,BTOP, 2 * BSURF,RSF,XK1,XK2) 1 SUBROUTINE rad_tridiagonal_matrix_solver(NL, 2 * GAMA,CP,CM,CPM1,CMM1,E1,E2,E3,E4, 3 * BTOP,BSURF,RSF,XK1,XK2) 3 4 4 5 C GCM2.0 Feb 2003 -
trunk/LMDZ.GENERIC/libf/phygeneric/radcommon_h.F90
r4055 r4077 63 63 ! 64 64 65 REAL*8 BWNI(L_NSPECTI+1), WNOI(L_NSPECTI), DWNI(L_NSPECTI), WAVEI(L_NSPECTI) !BWNI read by master in setspi66 REAL*8 BWNV(L_NSPECTV+1), WNOV(L_NSPECTV), DWNV(L_NSPECTV), WAVEV(L_NSPECTV) !BWNV read by master in setspv65 REAL*8 BWNI(L_NSPECTI+1), WNOI(L_NSPECTI), DWNI(L_NSPECTI), WAVEI(L_NSPECTI) !BWNI read by master in rad_correlatedk_init_thermal 66 REAL*8 BWNV(L_NSPECTV+1), WNOV(L_NSPECTV), DWNV(L_NSPECTV), WAVEV(L_NSPECTV) !BWNV read by master in rad_correlatedk_init_stellar 67 67 REAL*8 STELLARF(L_NSPECTV) 68 68 !$OMP THREADPRIVATE(WNOI,DWNI,WAVEI,& … … 81 81 real*8 pgasmin, pgasmax 82 82 real*8 tgasmin, tgasmax 83 !$OMP THREADPRIVATE(gasi,gasv,& !wrefvar,pgasref,tgasref,pfgasref read by master in sugas_corrk84 !$OMP FZEROI,FZEROV) !pgasmin,pgasmax,tgasmin,tgasmax read by master in sugas_corrk83 !$OMP THREADPRIVATE(gasi,gasv,& !wrefvar,pgasref,tgasref,pfgasref read by master in rad_correlatedk_read_opacity_tables 84 !$OMP FZEROI,FZEROV) !pgasmin,pgasmax,tgasmin,tgasmax read by master in rad_correlatedk_read_opacity_tables 85 85 86 86 real,allocatable,save :: QVISsQREF(:,:,:) … … 102 102 103 103 integer,allocatable,save :: nsize(:,:) 104 !$OMP THREADPRIVATE(nsize) ! nsize filled by suaer_corrk104 !$OMP THREADPRIVATE(nsize) ! nsize filled by rad_correlatedk_ini_aerosol 105 105 106 106 ! Particle size axis (depend on the kind of aerosol and the … … 111 111 112 112 ! Extinction coefficient at reference wavelengths; 113 ! These wavelengths are defined in aero ptproperties, and called113 ! These wavelengths are defined in aerosol_optical_properties, and called 114 114 ! longrefvis and longrefir. 115 115 … … 127 127 real*8,parameter :: UBARI = 0.5D0 128 128 129 !$OMP THREADPRIVATE(QREFvis,QREFir,omegaREFir,& ! gweight read by master in sugas_corrk129 !$OMP THREADPRIVATE(QREFvis,QREFir,omegaREFir,& ! gweight read by master in rad_correlatedk_read_opacity_tables 130 130 !$OMP tstellar,planckir,PTOP) 131 131 -
trunk/LMDZ.GENERIC/libf/phygeneric/radinc_h.F90
r2972 r4077 64 64 !$OMP THREADPRIVATE(L_NLAYRAD,L_LEVELS,L_NLEVRAD) 65 65 66 ! These are set in sugas_corrk66 ! These are set in rad_correlatedk_read_opacity_tables 67 67 ! [uses allocatable arrays] -- AS 12/2011 68 integer :: L_NPREF, L_NTREF, L_REFVAR, L_PINT, L_NGAUSS !L_NPREF, L_NTREF, L_REFVAR, L_PINT, L_NGAUSS read by master in sugas_corrk68 integer :: L_NPREF, L_NTREF, L_REFVAR, L_PINT, L_NGAUSS !L_NPREF, L_NTREF, L_REFVAR, L_PINT, L_NGAUSS read by master in rad_correlatedk_read_opacity_tables 69 69 70 70 integer, parameter :: L_NSPECTI = NBinfrared -
trunk/LMDZ.GENERIC/libf/phygeneric/rain.F90
r3893 r4077 4 4 use ioipsl_getin_p_mod, only: getin_p 5 5 use watercommon_h, only: T_h2O_ice_liq,T_h2O_ice_clouds, RLVTT, RCPD, RCPV, RW, RVTMP2,Psat_water,Tsat_water,rhowater 6 use radii_mod, only: h2o_cloudrad6 use aerosol_radius, only: h2o_cloudrad 7 7 USE tracer_h, only: igcm_h2o_vap, igcm_h2o_ice 8 8 use comcstfi_mod, only: g, r -
trunk/LMDZ.GENERIC/libf/phygeneric/rain_generic.F90
r3893 r4077 6 6 use watercommon_h, only: T_h2O_ice_liq,T_h2O_ice_clouds,rhowater 7 7 ! T_h2O_ice_clouds,rhowater are only used for precip_scheme_generic >=2 8 use radii_mod, only: h2o_cloudrad ! only used for precip_scheme_generic >=28 use aerosol_radius, only: h2o_cloudrad ! only used for precip_scheme_generic >=2 9 9 use tracer_h 10 10 use comcstfi_mod, only: g, r, cpp -
trunk/LMDZ.GENERIC/libf/phygeneric/su_gases.F90
r3893 r4077 145 145 146 146 if(count.ne.ngasmx)then 147 print*,'Mismatch between ngas and number of recognised gases in sugas_corrk.F90.'147 print*,'Mismatch between ngas and number of recognised gases in rad_correlatedk_read_opacity_tables .F90.' 148 148 print*,'Either we haven`t managed to assign all the gases, or there are duplicates.' 149 149 print*,'Please try again.'
Note: See TracChangeset
for help on using the changeset viewer.
