Context Navigation

sw_aeroAR4.F90 @ 1790

Last change on this file since 1790 was 1669, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1668

http://lmdz.lmd.jussieu.fr/utilisateurs/distribution-du-modele/versions-intermediaires

Testing release based on r1668

File size: 23.6 KB

Rev	Line
[1237]	1	!
	2	! $Id$
	3	!
[1153]	4	SUBROUTINE SW_AEROAR4(PSCT, PRMU0, PFRAC, &
[1150]	5	PPMB, PDP, &
	6	PPSOL, PALBD, PALBP,&
	7	PTAVE, PWV, PQS, POZON, PAER,&
	8	PCLDSW, PTAU, POMEGA, PCG,&
	9	PHEAT, PHEAT0,&
	10	PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,&
	11	ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,&
	12	tauaero, pizaero, cgaero,&
	13	PTAUA, POMEGAA,&
	14	PTOPSWADAERO,PSOLSWADAERO,&
	15	PTOPSWAD0AERO,PSOLSWAD0AERO,&
	16	PTOPSWAIAERO,PSOLSWAIAERO,&
	17	PTOPSWAERO,PTOPSW0AERO,&
	18	PSOLSWAERO,PSOLSW0AERO,&
[1246]	19	PTOPSWCFAERO,PSOLSWCFAERO,&
[1669]	20	ok_ade, ok_aie, flag_aerosol )
[1150]	21
	22	USE dimphy
[1669]	23	USE phys_output_mod, ONLY : swaero_diag
[1150]	24	IMPLICIT NONE
	25
	26	#include "YOMCST.h"
[1246]	27	#include "clesphys.h"
[1664]	28	#include "iniprint.h"
[1150]	29	!
	30	! ------------------------------------------------------------------
	31	!
	32	! PURPOSE.
	33	! --------
	34	!
	35	! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO
	36	! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980).
	37	!
	38	! METHOD.
	39	! -------
	40	!
	41	! 1. COMPUTES ABSORBER AMOUNTS (SWU)
	42	! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S)
	43	! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S)
	44	!
	45	! REFERENCE.
	46	! ----------
	47	!
	48	! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
	49	! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
	50	!
	51	! AUTHOR.
	52	! -------
	53	! JEAN-JACQUES MORCRETTE ECMWF
	54	!
	55	! MODIFICATIONS.
	56	! --------------
	57	! ORIGINAL : 89-07-14
[1669]	58	! 1995-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo
	59	! 2003-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER)
	60	! 2009-04 A. COZIC - C.DEANDREIS Indroduce NAT/BC/POM/DUST/SS aerosol forcing
	61	! 2012-09 O. BOUCHER - reorganise aerosol cases with ok_ade, ok_aie, flag_aerosol
[1150]	62	! ------------------------------------------------------------------
	63	!
	64	!* ARGUMENTS:
	65	!
[1220]	66	REAL(KIND=8) PSCT ! constante solaire (valeur conseillee: 1370)
[1150]	67
[1220]	68	REAL(KIND=8) PPSOL(KDLON) ! SURFACE PRESSURE (PA)
	69	REAL(KIND=8) PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA)
	70	REAL(KIND=8) PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB)
[1150]	71
[1220]	72	REAL(KIND=8) PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE
	73	REAL(KIND=8) PFRAC(KDLON) ! fraction de la journee
[1150]	74
[1220]	75	REAL(KIND=8) PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K)
	76	REAL(KIND=8) PWV(KDLON,KFLEV) ! SPECIFI! HUMIDITY (KG/KG)
	77	REAL(KIND=8) PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG)
	78	REAL(KIND=8) POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG)
	79	REAL(KIND=8) PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS
[1150]	80
[1220]	81	REAL(KIND=8) PALBD(KDLON,2) ! albedo du sol (lumiere diffuse)
	82	REAL(KIND=8) PALBP(KDLON,2) ! albedo du sol (lumiere parallele)
[1150]	83
[1220]	84	REAL(KIND=8) PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION
[1669]	85	REAL(KIND=8) PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value)
[1220]	86	REAL(KIND=8) PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR
	87	REAL(KIND=8) POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
[1150]	88
[1220]	89	REAL(KIND=8) PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY)
	90	REAL(KIND=8) PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky
	91	REAL(KIND=8) PALBPLA(KDLON) ! PLANETARY ALBEDO
	92	REAL(KIND=8) PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A.
	93	REAL(KIND=8) PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE
	94	REAL(KIND=8) PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY)
	95	REAL(KIND=8) PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY)
[1150]	96	!
	97	!* LOCAL VARIABLES:
	98	!
[1215]	99	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
	100
[1220]	101	REAL(KIND=8) ZOZ(KDLON,KFLEV)
[1215]	102	! column-density of ozone in layer, in kilo-Dobsons
	103
[1220]	104	REAL(KIND=8) ZAKI(KDLON,2)
	105	REAL(KIND=8) ZCLD(KDLON,KFLEV)
	106	REAL(KIND=8) ZCLEAR(KDLON)
	107	REAL(KIND=8) ZDSIG(KDLON,KFLEV)
	108	REAL(KIND=8) ZFACT(KDLON)
	109	REAL(KIND=8) ZFD(KDLON,KFLEV+1)
	110	REAL(KIND=8) ZFDOWN(KDLON,KFLEV+1)
	111	REAL(KIND=8) ZFU(KDLON,KFLEV+1)
	112	REAL(KIND=8) ZFUP(KDLON,KFLEV+1)
	113	REAL(KIND=8) ZRMU(KDLON)
	114	REAL(KIND=8) ZSEC(KDLON)
	115	REAL(KIND=8) ZUD(KDLON,5,KFLEV+1)
	116	REAL(KIND=8) ZCLDSW0(KDLON,KFLEV)
[1150]	117
[1220]	118	REAL(KIND=8) ZFSUP(KDLON,KFLEV+1)
	119	REAL(KIND=8) ZFSDN(KDLON,KFLEV+1)
	120	REAL(KIND=8) ZFSUP0(KDLON,KFLEV+1)
	121	REAL(KIND=8) ZFSDN0(KDLON,KFLEV+1)
[1150]	122
	123	INTEGER inu, jl, jk, i, k, kpl1
	124
	125	INTEGER swpas ! Every swpas steps, sw is calculated
	126	PARAMETER(swpas=1)
	127
[1159]	128	INTEGER, SAVE :: itapsw = 0
	129	!$OMP THREADPRIVATE(itapsw)
	130	LOGICAL, SAVE :: appel1er = .TRUE.
[1150]	131	!$OMP THREADPRIVATE(appel1er)
[1159]	132	LOGICAL, SAVE :: initialized = .FALSE.
	133	!$OMP THREADPRIVATE(initialized)
	134
[1669]	135	!jq-local flag introduced for aerosol forcings
[1220]	136	REAL(KIND=8), SAVE :: flag_aer
[1159]	137	!$OMP THREADPRIVATE(flag_aer)
	138
[1150]	139	LOGICAL ok_ade, ok_aie ! use aerosol forcings or not?
[1669]	140	INTEGER flag_aerosol ! global flag for aerosol 0 (no aerosol) or 1-5 (aerosols)
[1220]	141	REAL(KIND=8) tauaero(kdlon,kflev,9,2) ! aerosol optical properties
	142	REAL(KIND=8) pizaero(kdlon,kflev,9,2) ! (see aeropt.F)
	143	REAL(KIND=8) cgaero(kdlon,kflev,9,2) ! -"-
[1669]	144	REAL(KIND=8) PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (present-day value)
[1220]	145	REAL(KIND=8) POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO
	146	REAL(KIND=8) PTOPSWADAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
	147	REAL(KIND=8) PSOLSWADAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
[1669]	148	REAL(KIND=8) PTOPSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
	149	REAL(KIND=8) PSOLSWAD0AERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
[1220]	150	REAL(KIND=8) PTOPSWAIAERO(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
	151	REAL(KIND=8) PSOLSWAIAERO(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
[1669]	152	REAL(KIND=8) PTOPSWAERO(KDLON,9) ! SW TOA AS DRF nat & ant
	153	REAL(KIND=8) PTOPSW0AERO(KDLON,9) ! SW SRF AS DRF nat & ant
	154	REAL(KIND=8) PSOLSWAERO(KDLON,9) ! SW TOA CS DRF nat & ant
	155	REAL(KIND=8) PSOLSW0AERO(KDLON,9) ! SW SRF CS DRF nat & ant
[1246]	156	REAL(KIND=8) PTOPSWCFAERO(KDLON,3) ! SW TOA AS cloudRF nat & ant
	157	REAL(KIND=8) PSOLSWCFAERO(KDLON,3) ! SW SRF AS cloudRF nat & ant
[1150]	158
	159	!jq - Fluxes including aerosol effects
[1220]	160	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD_AERO(:,:)
[1150]	161	!$OMP THREADPRIVATE(ZFSUPAD_AERO)
[1220]	162	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD_AERO(:,:)
[1150]	163	!$OMP THREADPRIVATE(ZFSDNAD_AERO)
	164	!jq - Fluxes including aerosol effects
[1220]	165	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAD0_AERO(:,:)
[1150]	166	!$OMP THREADPRIVATE(ZFSUPAD0_AERO)
[1220]	167	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAD0_AERO(:,:)
[1150]	168	!$OMP THREADPRIVATE(ZFSDNAD0_AERO)
[1220]	169	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUPAI_AERO(:,:)
[1150]	170	!$OMP THREADPRIVATE(ZFSUPAI_AERO)
[1220]	171	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDNAI_AERO(:,:)
[1150]	172	!$OMP THREADPRIVATE(ZFSDNAI_AERO)
[1220]	173	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP_AERO(:,:,:)
[1150]	174	!$OMP THREADPRIVATE(ZFSUP_AERO)
[1220]	175	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN_AERO(:,:,:)
[1150]	176	!$OMP THREADPRIVATE(ZFSDN_AERO)
[1220]	177	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSUP0_AERO(:,:,:)
[1150]	178	!$OMP THREADPRIVATE(ZFSUP0_AERO)
[1220]	179	REAL(KIND=8),ALLOCATABLE,SAVE :: ZFSDN0_AERO(:,:,:)
[1150]	180	!$OMP THREADPRIVATE(ZFSDN0_AERO)
	181
[1246]	182	! Key to define the aerosol effect acting on climate
[1669]	183	! OB: AEROSOLFEEDBACK_ACTIVE is now a LOGICAL
	184	! TRUE: fluxes use natural and/or anthropogenic aerosols according to ok_ade and ok_aie, DEFAULT
	185	! FALSE: fluxes use no aerosols (case 1)
[1150]	186
[1669]	187	LOGICAL,SAVE :: AEROSOLFEEDBACK_ACTIVE = .TRUE.
[1249]	188	!$OMP THREADPRIVATE(AEROSOLFEEDBACK_ACTIVE)
[1246]	189
[1307]	190	CHARACTER (LEN=20) :: modname='sw_aeroAR4'
	191	CHARACTER (LEN=80) :: abort_message
	192
[1150]	193	IF(.NOT.initialized) THEN
	194	flag_aer=0.
	195	initialized=.TRUE.
	196	ALLOCATE(ZFSUPAD_AERO(KDLON,KFLEV+1))
	197	ALLOCATE(ZFSDNAD_AERO(KDLON,KFLEV+1))
	198	ALLOCATE(ZFSUPAD0_AERO(KDLON,KFLEV+1))
	199	ALLOCATE(ZFSDNAD0_AERO(KDLON,KFLEV+1))
	200	ALLOCATE(ZFSUPAI_AERO(KDLON,KFLEV+1))
	201	ALLOCATE(ZFSDNAI_AERO(KDLON,KFLEV+1))
[1669]	202	!-OB decrease size of these arrays to what is needed
	203	! \| direct effect
	204	!ind effect \| no aerosol natural total
	205	!natural (PTAU) \| 1 3 2 --ZFSUP/ZFSDN
	206	!total (PTAUA) \| 5 4 --ZFSUP/ZFSDN
	207	!no cloud \| 1 3 2 --ZFSUP0/ZFSDN0
	208	! so we need which case when ?
	209	! ok_ade and ok_aie = 4-5, 4-2 and 2
	210	! ok_ade and not ok_aie = 2-3 and 2
	211	! not ok_ade and ok_aie = 5-3 and 5
	212	! not ok_ade and not ok_aie = 3
	213	! therefore the cases have the folliwng switches
	214	! 3 = not ok_ade or not ok_aie
	215	! 4 = ok_ade and ok_aie
	216	! 2 = ok_ade
	217	! 5 = ok_aie
	218	ALLOCATE(ZFSUP_AERO (KDLON,KFLEV+1,5))
	219	ALLOCATE(ZFSDN_AERO (KDLON,KFLEV+1,5))
	220	ALLOCATE(ZFSUP0_AERO(KDLON,KFLEV+1,3))
	221	ALLOCATE(ZFSDN0_AERO(KDLON,KFLEV+1,3))
	222	! end OB modif
[1150]	223	ZFSUPAD_AERO(:,:)=0.
	224	ZFSDNAD_AERO(:,:)=0.
	225	ZFSUPAD0_AERO(:,:)=0.
	226	ZFSDNAD0_AERO(:,:)=0.
	227	ZFSUPAI_AERO(:,:)=0.
	228	ZFSDNAI_AERO(:,:)=0.
	229	ZFSUP_AERO (:,:,:)=0.
	230	ZFSDN_AERO (:,:,:)=0.
	231	ZFSUP0_AERO(:,:,:)=0.
	232	ZFSDN0_AERO(:,:,:)=0.
	233	ENDIF
	234
	235	IF (appel1er) THEN
[1669]	236	WRITE(lunout,*)'SW calling frequency : ', swpas
[1664]	237	WRITE(lunout,*) " In general, it should be 1"
[1150]	238	appel1er = .FALSE.
	239	ENDIF
	240	! ------------------------------------------------------------------
	241	IF (MOD(itapsw,swpas).EQ.0) THEN
	242
	243	DO JK = 1 , KFLEV
	244	DO JL = 1, KDLON
	245	ZCLDSW0(JL,JK) = 0.0
[1237]	246	ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG &
	247	PDP(JL,JK)(101325.0/PPSOL(JL))
[1150]	248	ENDDO
	249	ENDDO
	250
[1669]	251	! clear sky with no aerosols at all is computed IF ACTIVEFEEDBACK_ACTIVE is false or for extended diag
	252	IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
[1150]	253
[1246]	254	! clear-sky: zero aerosol effect
[1150]	255	flag_aer=0.0
	256	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
	257	PRMU0,PFRAC,PTAVE,PWV,&
	258	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	259	INU = 1
	260	CALL SW1S_LMDAR4(INU,PAER, flag_aer, &
	261	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
	262	PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
	263	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	264	ZFD, ZFU)
	265	INU = 2
	266	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
	267	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
	268	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,&
	269	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	270	PWV, PQS,&
	271	ZFDOWN, ZFUP)
	272	DO JK = 1 , KFLEV+1
	273	DO JL = 1, KDLON
[1237]	274	ZFSUP0_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	275	ZFSDN0_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	276	ENDDO
	277	ENDDO
[1669]	278	ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
[1150]	279
[1669]	280	! cloudy sky with no aerosols at all is either computed IF no indirect effect is asked for, or for extended diag
	281	IF ( swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE .OR. flag_aerosol .EQ. 0 ) THEN
[1246]	282	! cloudy-sky: zero aerosol effect
[1150]	283	flag_aer=0.0
	284	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
	285	PRMU0,PFRAC,PTAVE,PWV,&
	286	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	287	INU = 1
	288	CALL SW1S_LMDAR4(INU, PAER, flag_aer, &
	289	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
	290	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	291	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	292	ZFD, ZFU)
	293	INU = 2
	294	CALL SW2S_LMDAR4(INU, PAER, flag_aer, &
	295	tauaero(:,:,1,:), pizaero(:,:,1,:), cgaero(:,:,1,:),&
	296	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	297	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	298	PWV, PQS,&
	299	ZFDOWN, ZFUP)
	300
	301	DO JK = 1 , KFLEV+1
	302	DO JL = 1, KDLON
[1237]	303	ZFSUP_AERO(JL,JK,1) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	304	ZFSDN_AERO(JL,JK,1) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	305	ENDDO
	306	ENDDO
[1669]	307	ENDIF ! swaero_diag .or. .not. AEROSOLFEEDBACK_ACTIVE
[1150]	308
[1669]	309	IF (flag_aerosol .GT. 0 ) THEN
[1150]	310
[1669]	311	IF (ok_ade.and.swaero_diag .or. .not. ok_ade) THEN
[1150]	312
[1669]	313	! clear sky direct effect natural aerosol
	314	! CAS AER (3)
[1150]	315	flag_aer=1.0
	316	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
	317	PRMU0,PFRAC,PTAVE,PWV,&
	318	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	319	INU = 1
	320	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
[1669]	321	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
[1150]	322	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	323	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	324	ZFD, ZFU)
	325	INU = 2
	326	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
[1669]	327	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
[1150]	328	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	329	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	330	PWV, PQS,&
	331	ZFDOWN, ZFUP)
	332
	333	DO JK = 1 , KFLEV+1
	334	DO JL = 1, KDLON
[1669]	335	ZFSUP0_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	336	ZFSDN0_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	337	ENDDO
	338	ENDDO
[1669]	339	ENDIF !--end not swaero_diag or not ok_ade
[1150]	340
[1669]	341	IF (ok_ade) THEN
	342
	343	! clear sky direct effect of total aerosol
	344	! CAS AER (2)
[1150]	345	flag_aer=1.0
[1669]	346	CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,&
[1150]	347	PRMU0,PFRAC,PTAVE,PWV,&
	348	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	349	INU = 1
	350	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
	351	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
	352	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	353	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	354	ZFD, ZFU)
	355	INU = 2
	356	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
	357	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
	358	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	359	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	360	PWV, PQS,&
	361	ZFDOWN, ZFUP)
	362
	363	DO JK = 1 , KFLEV+1
	364	DO JL = 1, KDLON
[1669]	365	ZFSUP0_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	366	ZFSDN0_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	367	ENDDO
	368	ENDDO
	369
[1669]	370	! cloudy-sky with natural aerosols for indirect effect
	371	! but total aerosols for direct effect
	372	! PTAU
	373	! CAS AER (2)
[1150]	374	flag_aer=1.0
[1669]	375	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
[1150]	376	PRMU0,PFRAC,PTAVE,PWV,&
	377	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	378	INU = 1
	379	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
[1669]	380	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
[1150]	381	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	382	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	383	ZFD, ZFU)
	384	INU = 2
	385	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
[1669]	386	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
[1150]	387	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	388	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	389	PWV, PQS,&
	390	ZFDOWN, ZFUP)
	391
	392	DO JK = 1 , KFLEV+1
	393	DO JL = 1, KDLON
[1669]	394	ZFSUP_AERO(JL,JK,2) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	395	ZFSDN_AERO(JL,JK,2) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	396	ENDDO
	397	ENDDO
	398
[1669]	399	ENDIF !-end ok_ade
	400
	401	IF ( .not. ok_ade .or. .not. ok_aie ) THEN
	402
	403	! cloudy-sky with natural aerosols for indirect effect
	404	! and natural aerosols for direct effect
	405	! PTAU
	406	! CAS AER (3)
[1246]	407	! cloudy-sky direct effect natural aerosol
[1150]	408	flag_aer=1.0
	409	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
	410	PRMU0,PFRAC,PTAVE,PWV,&
	411	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	412	INU = 1
	413	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
	414	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
	415	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	416	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	417	ZFD, ZFU)
	418	INU = 2
	419	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
	420	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
	421	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	422	ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,&
	423	PWV, PQS,&
	424	ZFDOWN, ZFUP)
	425
	426	DO JK = 1 , KFLEV+1
	427	DO JL = 1, KDLON
	428	ZFSUP_AERO(JL,JK,3) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	429	ZFSDN_AERO(JL,JK,3) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
	430	ENDDO
	431	ENDDO
	432
[1669]	433	ENDIF !--true/false or false/true
[1150]	434
[1669]	435	IF (ok_ade .and. ok_aie) THEN
	436
	437	! cloudy-sky with total aerosols for indirect effect
	438	! and total aerosols for direct effect
	439	! PTAUA
	440	! CAS AER (2)
[1150]	441	flag_aer=1.0
	442	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
	443	PRMU0,PFRAC,PTAVE,PWV,&
	444	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	445	INU = 1
	446	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
	447	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
	448	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	449	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
	450	ZFD, ZFU)
	451	INU = 2
	452	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
	453	tauaero(:,:,2,:), pizaero(:,:,2,:), cgaero(:,:,2,:),&
	454	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	455	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
	456	PWV, PQS,&
	457	ZFDOWN, ZFUP)
[1669]	458
[1150]	459	DO JK = 1 , KFLEV+1
	460	DO JL = 1, KDLON
[1237]	461	ZFSUP_AERO(JL,JK,4) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	462	ZFSDN_AERO(JL,JK,4) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
[1150]	463	ENDDO
	464	ENDDO
[1669]	465
	466	ENDIF ! ok_ade .and. ok_aie
	467
	468	IF (ok_aie) THEN
	469	! cloudy-sky with total aerosols for indirect effect
	470	! and natural aerosols for direct effect
	471	! PTAUA
	472	! CAS AER (3)
	473	flag_aer=1.0
	474	CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,&
	475	PRMU0,PFRAC,PTAVE,PWV,&
	476	ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
	477	INU = 1
	478	CALL SW1S_LMDAR4(INU, PAER, flag_aer,&
	479	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
	480	PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	481	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
	482	ZFD, ZFU)
	483	INU = 2
	484	CALL SW2S_LMDAR4(INU, PAER, flag_aer,&
	485	tauaero(:,:,3,:), pizaero(:,:,3,:), cgaero(:,:,3,:),&
	486	ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,&
	487	ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,&
	488	PWV, PQS,&
	489	ZFDOWN, ZFUP)
	490
	491	DO JK = 1 , KFLEV+1
	492	DO JL = 1, KDLON
	493	ZFSUP_AERO(JL,JK,5) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL)
	494	ZFSDN_AERO(JL,JK,5) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
	495	ENDDO
	496	ENDDO
	497
[1150]	498	ENDIF ! ok_aie
	499
[1669]	500	ENDIF !--if flag_aerosol GT 0
	501
[1150]	502	itapsw = 0
	503	ENDIF
	504	itapsw = itapsw + 1
	505
[1669]	506	IF ( AEROSOLFEEDBACK_ACTIVE .AND. flag_aerosol .GT. 0 ) THEN
[1237]	507	IF ( ok_ade .and. ok_aie ) THEN
	508	ZFSUP(:,:) = ZFSUP_AERO(:,:,4)
	509	ZFSDN(:,:) = ZFSDN_AERO(:,:,4)
	510	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
	511	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
	512	ENDIF
[1669]	513
[1237]	514	IF ( ok_ade .and. (.not. ok_aie) ) THEN
	515	ZFSUP(:,:) = ZFSUP_AERO(:,:,2)
	516	ZFSDN(:,:) = ZFSDN_AERO(:,:,2)
	517	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,2)
	518	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,2)
	519	ENDIF
[1246]	520
[1237]	521	IF ( (.not. ok_ade) .and. ok_aie ) THEN
[1669]	522	ZFSUP(:,:) = ZFSUP_AERO(:,:,5)
	523	ZFSDN(:,:) = ZFSDN_AERO(:,:,5)
	524	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
	525	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
[1237]	526	ENDIF
[1669]	527
[1237]	528	IF ((.not. ok_ade) .and. (.not. ok_aie)) THEN
[1669]	529	ZFSUP(:,:) = ZFSUP_AERO(:,:,3)
	530	ZFSDN(:,:) = ZFSDN_AERO(:,:,3)
	531	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,3)
	532	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,3)
[1237]	533	ENDIF
	534
	535	! MS the following allows to compute the forcing diagostics without
	536	! letting the aerosol forcing act on the meteorology
[1246]	537	! SEE logic above
[1669]	538	ELSE
	539	ZFSUP(:,:) = ZFSUP_AERO(:,:,1)
	540	ZFSDN(:,:) = ZFSDN_AERO(:,:,1)
	541	ZFSUP0(:,:) = ZFSUP0_AERO(:,:,1)
	542	ZFSDN0(:,:) = ZFSDN0_AERO(:,:,1)
[1237]	543	ENDIF
	544
[1669]	545	! Now computes heating rates
[1150]	546	DO k = 1, KFLEV
	547	kpl1 = k+1
	548	DO i = 1, KDLON
[1237]	549	PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k))-(ZFSDN(i,k)-ZFSDN(i,kpl1))
[1150]	550	PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
[1237]	551	PHEAT0(i,k) = -(ZFSUP0(i,kpl1)-ZFSUP0(i,k))-(ZFSDN0(i,k)-ZFSDN0(i,kpl1))
[1150]	552	PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k)
	553	ENDDO
	554	ENDDO
[1237]	555
[1150]	556	DO i = 1, KDLON
[1246]	557	! effective SW surface albedo calculation
[1150]	558	PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20)
[1246]	559
	560	! clear sky net fluxes at TOA and SRF
[1150]	561	PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
	562	PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
	563
[1246]	564	! cloudy sky net fluxes at TOA and SRF
[1150]	565	PSOLSW(i) = ZFSDN(i,1) - ZFSUP(i,1)
	566	PTOPSW(i) = ZFSDN(i,KFLEV+1) - ZFSUP(i,KFLEV+1)
	567
[1246]	568	! net anthropogenic forcing direct and 1st indirect effect diagnostics
	569	! requires a natural aerosol field read and used
	570	! Difference of net fluxes from double call to radiation
[1150]	571
[1246]	572	IF (ok_ade) THEN
[1150]	573
[1246]	574	! indices 1: natural; 2 anthropogenic
[1669]	575
[1246]	576	! TOA/SRF all sky natural forcing
	577	PSOLSWAERO(i,1) = (ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))-(ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))
	578	PTOPSWAERO(i,1) = (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))- (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))
[1150]	579
[1669]	580	! TOA/SRF clear sky natural forcing
	581	PSOLSW0AERO(i,1) = (ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
	582	PTOPSW0AERO(i,1) = (ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))-(ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
	583
	584	IF (ok_aie) THEN
	585
[1246]	586	! TOA/SRF all sky anthropogenic forcing
[1669]	587	PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))
	588	PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))- (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))
	589
	590	ELSE
	591
	592	! TOA/SRF all sky anthropogenic forcing
[1246]	593	PSOLSWAERO(i,2) = (ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
	594	PTOPSWAERO(i,2) = (ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))- (ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
	595
[1669]	596	ENDIF
[1246]	597
	598	! TOA/SRF clear sky anthropogenic forcing
	599	PSOLSW0AERO(i,2) = (ZFSDN0_AERO(i,1,2) - ZFSUP0_AERO(i,1,2))-(ZFSDN0_AERO(i,1,3) - ZFSUP0_AERO(i,1,3))
	600	PTOPSW0AERO(i,2) = (ZFSDN0_AERO(i,KFLEV+1,2) - ZFSUP0_AERO(i,KFLEV+1,2))-(ZFSDN0_AERO(i,KFLEV+1,3) - ZFSUP0_AERO(i,KFLEV+1,3))
	601
[1669]	602	! direct anthropogenic forcing , as in old LMDzT, however differences of net fluxes
	603	PSOLSWADAERO(i) = PSOLSWAERO(i,2)
	604	PTOPSWADAERO(i) = PTOPSWAERO(i,2)
	605	PSOLSWAD0AERO(i) = PSOLSW0AERO(i,2)
	606	PTOPSWAD0AERO(i) = PTOPSW0AERO(i,2)
	607
	608	! OB: these diagnostics may not always work but who need them
[1246]	609	! Cloud forcing indices 1: natural; 2 anthropogenic; 3: zero aerosol direct effect
	610	! Instantaneously computed cloudy sky direct aerosol effect, cloud forcing due to aerosols above clouds
	611	! natural
	612	PSOLSWCFAERO(i,1) = PSOLSWAERO(i,1) - PSOLSW0AERO(i,1)
	613	PTOPSWCFAERO(i,1) = PTOPSWAERO(i,1) - PTOPSW0AERO(i,1)
	614
	615	! Instantaneously computed cloudy SKY DIRECT aerosol effect, cloud forcing due to aerosols above clouds
	616	! anthropogenic
	617	PSOLSWCFAERO(i,2) = PSOLSWAERO(i,2) - PSOLSW0AERO(i,2)
	618	PTOPSWCFAERO(i,2) = PTOPSWAERO(i,2) - PTOPSW0AERO(i,2)
	619
	620	! Cloudforcing without aerosol
	621	! zero
	622	PSOLSWCFAERO(i,3) = (ZFSDN_AERO(i,1,1) - ZFSUP_AERO(i,1,1))-(ZFSDN0_AERO(i,1,1) - ZFSUP0_AERO(i,1,1))
	623	PTOPSWCFAERO(i,3) = (ZFSDN_AERO(i,KFLEV+1,1) - ZFSUP_AERO(i,KFLEV+1,1))- (ZFSDN0_AERO(i,KFLEV+1,1) - ZFSUP0_AERO(i,KFLEV+1,1))
	624
	625	ENDIF
	626
	627	IF (ok_aie) THEN
[1669]	628	IF (ok_ade) THEN
[1237]	629	PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,4) - ZFSUP_AERO(i,1,4))-(ZFSDN_AERO(i,1,2) - ZFSUP_AERO(i,1,2))
	630	PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,4) - ZFSUP_AERO(i,KFLEV+1,4))-(ZFSDN_AERO(i,KFLEV+1,2) - ZFSUP_AERO(i,KFLEV+1,2))
[1669]	631	ELSE
	632	PSOLSWAIAERO(i) = (ZFSDN_AERO(i,1,5) - ZFSUP_AERO(i,1,5))-(ZFSDN_AERO(i,1,3) - ZFSUP_AERO(i,1,3))
	633	PTOPSWAIAERO(i) = (ZFSDN_AERO(i,KFLEV+1,5) - ZFSUP_AERO(i,KFLEV+1,5))-(ZFSDN_AERO(i,KFLEV+1,3) - ZFSUP_AERO(i,KFLEV+1,3))
	634	ENDIF
[1246]	635	ENDIF
[1237]	636
[1669]	637	ENDDO
	638
[1153]	639	END SUBROUTINE SW_AEROAR4

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format