Context Navigation

sw_aeroAR4.F90 @ 5427

Last change on this file since 5427 was 1308, checked in by Laurent Fairhead, 15 years ago

Changes in output options for aerosols

Changements dans les options de sorties pour les aerosols

ACo

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

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

Download in other formats:

Original Format