PROGRAM rforcmain use iophy use ioipsl use dimphy use mod_phys_lmdz_para IMPLICIT none c******************************************************************************* c Calcul du forcage radiatif avec ajustement stratospherique c A. Idelkadi le 6 mars 2007 c******************************************************************************* C ! JLD: 2009-07-12 ! + add the flux and the forcing at the surface C JLD 2008-11-29 C + propbleme de transfert de la grille de lecture à la grille C physique: debut de re-ecriture C + supression d'une lecture specifique pour l'albedo #include "dimensions.h" #include "temps.h" #include "clesphys.h" c====================================================================== INTEGER ngridmx PARAMETER( ngridmx = 2+(jjm-1)*iim - 1/jjm ) c fichier de sortie LMDz contenant les champs qui sera lu pour le calcul C des forcages CHARACTER*80 tapename,tapename_ref PARAMETER(tapename_ref="histmth_ref.nc",tapename="histmth.nc") INTEGER nvert ! ID vertical axis C INTEGER mois PARAMETER (mois=12) ! PARAMETER (mois=1) ! changer aussi les DATA de julien REAL dtime ! pas de l'iteration en secondes PARAMETER (dtime=86400.0) real rjour INTEGER jour, julien(mois) INTEGER i, k, j, itap, m, n REAL rlon_1d(iim),rlat_1d(jjm+1), presl_1d(llm) c Variables sur grille physique REAL tfi(ngridmx,llm),qfi(ngridmx,llm), $ tfi_adj(ngridmx,llm) ! adjusted 3D temp profile REAL paprsfi(ngridmx,llm+1),pplayfi(ngridmx,llm) integer read_climoz ! read ozone climatology Parameter (read_climoz=2) REAL ozone(ngridmx,llm),ozone_ref(ngridmx,llm) Real ozone_daylight(ngridmx,llm),ozone_daylight_ref(ngridmx,llm) REAL rlonfi(ngridmx),rlatfi(ngridmx) REAL cldliqfi(ngridmx,llm),cldfrafi(ngridmx,llm) REAL albsfi(ngridmx) REAL phisfi(ngridmx),airefi(ngridmx),tsolfi(ngridmx) c reference profile REAL tps_sw_ref(ngridmx),tps_lw_ref(ngridmx) REAL tps_sw_ref0(ngridmx),tps_lw_ref0(ngridmx) REAL toa_sw_ref(ngridmx),toa_lw_ref(ngridmx) REAL toa_sw_ref0(ngridmx),toa_lw_ref0(ngridmx) REAL srf_sw_ref(ngridmx),srf_lw_ref(ngridmx) REAL srf_sw_ref0(ngridmx),srf_lw_ref0(ngridmx) c initial values (with modofied PARAMETER, but no strato. adjustment) REAL tps_sw_ini(ngridmx),tps_lw_ini(ngridmx) REAL tps_sw_ini0(ngridmx),tps_lw_ini0(ngridmx) REAL toa_sw_ini(ngridmx),toa_lw_ini(ngridmx) REAL toa_sw_ini0(ngridmx),toa_lw_ini0(ngridmx) c initial anomalies REAL d_tps_sw_ini(ngridmx),d_tps_lw_ini(ngridmx) REAL d_tps_sw_ini0(ngridmx),d_tps_lw_ini0(ngridmx) REAL d_toa_sw_ini(ngridmx),d_toa_lw_ini(ngridmx) REAL d_toa_sw_ini0(ngridmx),d_toa_lw_ini0(ngridmx) c c adjusted values (with modofied PARAMETER, and strato. adjustment) c adjusted values (with modofied PARAMETER, and strato. adjustment) REAL tps_sw_adj(ngridmx),tps_lw_adj(ngridmx) REAL tps_sw_adj0(ngridmx),tps_lw_adj0(ngridmx) REAL toa_sw_adj(ngridmx),toa_lw_adj(ngridmx) REAL toa_sw_adj0(ngridmx),toa_lw_adj0(ngridmx) REAL srf_sw_adj(ngridmx),srf_lw_adj(ngridmx) REAL srf_sw_adj0(ngridmx),srf_lw_adj0(ngridmx) REAL d_tps_sw_adj(ngridmx),d_tps_lw_adj(ngridmx) REAL d_tps_sw_adj0(ngridmx),d_tps_lw_adj0(ngridmx) REAL d_toa_sw_adj(ngridmx),d_toa_lw_adj(ngridmx) REAL d_toa_sw_adj0(ngridmx),d_toa_lw_adj0(ngridmx) REAL d_srf_sw_adj(ngridmx),d_srf_lw_adj(ngridmx) REAL d_srf_sw_adj0(ngridmx),d_srf_lw_adj0(ngridmx) ! ! Bilan radiatif SW (heat) et LW (cool) des differentes couche de l'atmopshre REAL heat_ref(ngridmx,llm), heat0_ref(ngridmx,llm), $ cool_ref(ngridmx,llm), cool0_ref(ngridmx,llm) REAL d_heat_ini(ngridmx,llm), d_heat0_ini(ngridmx,llm), $ d_cool_ini(ngridmx,llm), d_cool0_ini(ngridmx,llm) REAL d_heat_adj(ngridmx,llm), d_heat0_adj(ngridmx,llm), $ d_cool_adj(ngridmx,llm), d_cool0_adj(ngridmx,llm) ! REAL dHrad_dT(ngridmx,llm) ! derivative the radiative heating with temperature REAL bilq_ref(ngridmx),bilq_ini(ngridmx),bilq_adj(ngridmx) DATA (julien(m),m=1,mois) /15, 45, 75, 105, 135, 165, . 195, 225, 255, 285, 315, 345/ C DATA (julien(m),m=1,mois) /75/ c C C Diagnostiques: Valeures moyennes, sur le globe C ================================================ C REAL aire_tot C Valeures mensuelles, moyenne sur le globe C C Bilan rad. de la stratosphere REAL bil_str_ref_m(mois), bil_str_ini_m(mois) $ ,bil_str_adj_m(mois) ! C Flux au sommet de l'atm REAL toa_sw_ref_m(mois), toa_sw_ref0_m(mois) $ , toa_lw_ref_m(mois), toa_lw_ref0_m(mois) C Forcage initial au sommet de l'atm REAL d_toa_sw_ini_m(mois), d_toa_sw_ini0_m(mois) $ ,d_toa_lw_ini_m(mois), d_toa_lw_ini0_m(mois) C Forcage ajuste au sommet de l'atm REAL d_toa_sw_adj_m(mois), d_toa_sw_adj0_m(mois) $ ,d_toa_lw_adj_m(mois), d_toa_lw_adj0_m(mois) ! C Flux a la tropopause REAL tps_sw_ref_m(mois), tps_sw_ref0_m(mois) $ , tps_lw_ref_m(mois), tps_lw_ref0_m(mois) C Forcage initial a la tropopause REAL d_tps_sw_ini_m(mois), d_tps_sw_ini0_m(mois) $ ,d_tps_lw_ini_m(mois), d_tps_lw_ini0_m(mois) C Forcage ajuste a la tropopause REAL d_tps_sw_adj_m(mois), d_tps_sw_adj0_m(mois) $ ,d_tps_lw_adj_m(mois), d_tps_lw_adj0_m(mois) ! C Flux a la surface REAL srf_sw_ref_m(mois), srf_sw_ref0_m(mois) $ , srf_lw_ref_m(mois), srf_lw_ref0_m(mois) C Forcage ajuste a la surface REAL d_srf_sw_adj_m(mois), d_srf_sw_adj0_m(mois) $ ,d_srf_lw_adj_m(mois), d_srf_lw_adj0_m(mois) ! Bilan radiatif de la stratosphere REAL bilq_ref_m(mois),bilq_ini_m(mois),bilq_adj_m(mois) C C Valeures annuelle, moyenne sur le globe C ================================================ C C bilan rad. de la stratosphere REAL bil_str_ref_yr, bil_str_ini_yr, bil_str_adj_yr C Flux au sommet de l'atm REAL toa_sw_ref_yr, toa_sw_ref0_yr $ , toa_lw_ref_yr, toa_lw_ref0_yr C Forcage initial au sommet de l'atm REAL d_toa_sw_ini_yr, d_toa_sw_ini0_yr $ ,d_toa_lw_ini_yr, d_toa_lw_ini0_yr C Forcage ajuste au sommet de l'atm REAL d_toa_sw_adj_yr, d_toa_sw_adj0_yr $ ,d_toa_lw_adj_yr, d_toa_lw_adj0_yr ! C Flux a la tropopause REAL tps_sw_ref_yr, tps_sw_ref0_yr $ , tps_lw_ref_yr, tps_lw_ref0_yr C Forcage initial a la tropopause REAL d_tps_sw_ini_yr, d_tps_sw_ini0_yr $ ,d_tps_lw_ini_yr, d_tps_lw_ini0_yr C Forcage ajuste a la tropopause REAL d_tps_sw_adj_yr, d_tps_sw_adj0_yr $ ,d_tps_lw_adj_yr, d_tps_lw_adj0_yr ! C Flux au sommet de l'atm REAL srf_sw_ref_yr, srf_sw_ref0_yr $ , srf_lw_ref_yr, srf_lw_ref0_yr C Forcage ajuste au sommet de l'atm REAL d_srf_sw_adj_yr, d_srf_sw_adj0_yr $ ,d_srf_lw_adj_yr, d_srf_lw_adj0_yr C == fin diagnostiques moyenne sur le globe C c Initialisation des sorties real zstophy,zstoday,zout,zjulian Cjld integer nhori,nid_day,day_ref integer nhori,nid_day save nid_day INTEGER ndex2d(iim*(jjm+1)) REAL zx_tmp_2d(iim,jjm+1) INTEGER ndex3d(iim*(jjm+1)*llm) REAL zx_tmp_3d(iim,jjm+1,llm) C LOGICAL aqua_planette PARAMETER (aqua_planette=.false.) C LOGICAL debug PARAMETER (debug=.false.) C REAL x_ave, x_std, x_min, x_max REAL undef DATA undef/9999./ c call Init_Phys_lmdz(iim,jjm+1,llm,1,(jjm-1)*iim+2) C C Initialisation des variables C C Diagnostiques en moyenne sur le globe DO m =1,mois C Flux au sommet de l'atmosphère toa_sw_ref_m(m) = 0. toa_sw_ref0_m(m) = 0. toa_lw_ref_m(m) = 0. toa_lw_ref0_m(m) = 0. C Forcage initial au sommet de l'atm d_toa_sw_ini_m(m) = 0. d_toa_sw_ini0_m(m) = 0. d_toa_lw_ini_m(m) = 0. d_toa_lw_ini0_m(m) = 0. C Forcage ajuste au sommet de l'atm d_toa_sw_adj_m(m) = 0. d_toa_sw_adj0_m(m) = 0. d_toa_lw_adj_m(m) = 0. d_toa_lw_adj0_m(m) = 0. C Flux a la tropopause tps_sw_ref_m(m) = 0. tps_sw_ref0_m(m) = 0. tps_lw_ref_m(m) = 0. tps_lw_ref0_m(m) = 0. C Forcage initial a la tropopause d_tps_sw_ini_m(m) = 0. d_tps_sw_ini0_m(m) = 0. d_tps_lw_ini_m(m) = 0. d_tps_lw_ini0_m(m) = 0. C Forcage ajuste a la tropopause d_tps_sw_adj_m(m) = 0. d_tps_sw_adj0_m(m) = 0. d_tps_lw_adj_m(m) = 0. d_tps_lw_adj0_m(m) = 0. C Flux a la surface srf_sw_ref_m(m) = 0. srf_sw_ref0_m(m) = 0. srf_lw_ref_m(m) = 0. srf_lw_ref0_m(m) = 0. C Forcage ajuste a la surface d_srf_sw_adj_m(m) = 0. d_srf_sw_adj0_m(m) = 0. d_srf_lw_adj_m(m) = 0. d_srf_lw_adj0_m(m) = 0. ! Bilan radiatif de la stratosphere bilq_ref_m(m) = 0. bilq_ini_m(m) = 0. bilq_adj_m(m) = 0. C END DO ! boucle sur les mois m C C moyenne annuelle C Flux au sommet de l'atmosphère toa_sw_ref_yr = 0. toa_sw_ref0_yr = 0. toa_lw_ref_yr = 0. toa_lw_ref0_yr = 0. C Forcage initial au sommet de l'atm d_toa_sw_ini_yr = 0. d_toa_sw_ini0_yr = 0. d_toa_lw_ini_yr = 0. d_toa_lw_ini0_yr = 0. C Forcage ajuste au sommet de l'atm d_toa_sw_adj_yr = 0. d_toa_sw_adj0_yr = 0. d_toa_lw_adj_yr = 0. d_toa_lw_adj0_yr = 0. C Flux a la tropopause tps_sw_ref_yr = 0. tps_sw_ref0_yr = 0. tps_lw_ref_yr = 0. tps_lw_ref0_yr = 0. C Forcage initial a la tropopause d_tps_sw_ini_yr = 0. d_tps_sw_ini0_yr = 0. d_tps_lw_ini_yr = 0. d_tps_lw_ini0_yr = 0. C Forcage ajuste a la tropopause d_tps_sw_adj_yr = 0. d_tps_sw_adj0_yr = 0. d_tps_lw_adj_yr = 0. d_tps_lw_adj0_yr = 0. C Flux a la surface srf_sw_ref_yr = 0. srf_sw_ref0_yr = 0. srf_lw_ref_yr = 0. srf_lw_ref0_yr = 0. C Forcage ajuste a la surface d_srf_sw_adj_yr = 0. d_srf_sw_adj0_yr = 0. d_srf_lw_adj_yr = 0. d_srf_lw_adj0_yr = 0. c lecture des variables a chaque mois C================================================================================ C*********DEBUT DE LA BOUCLE TEMPORELLE µµµµ************************************µ C================================================================================ DO 99999 m = 1, mois CJLD DO 99999 m = 1, 2 WRITE (*,*) 'Mois :',m c jour = julien(m) rjour=FLOAT(jour) IF (aqua_planette) rjour=75. print*,'Appel de lirehist, rjour=',rjour !!! Abderrahmane juin 2011 ! On lit dans le fichier de sortie histmth.nc l'ozone "perturbe" CALL lirehist(tapename_ref,iim,jjm+1,llm,ngridmx,mois,m, . read_climoz,tsolfi,paprsfi,pplayfi,tfi,qfi, . cldfrafi,cldliqfi,ozone,ozone_daylight, . rlonfi, rlatfi, phisfi, airefi, albsfi, . rlon_1d, rlat_1d, presl_1d) CALL lirehist(tapename,iim,jjm+1,llm, ngridmx,mois,m,read_climoz, . tsolfi,paprsfi,pplayfi,tfi,qfi,cldfrafi,cldliqfi,ozone_ref, . ozone_daylight_ref,rlonfi, rlatfi, phisfi, airefi, albsfi, . rlon_1d, rlat_1d, presl_1d) print*,'Apres lirehist' C IF (debug) print*,'Appel ozonecm, rjour=',rjour IF (debug) THEN PRINT *,'klon',klon CALL cstat(klon*klev,ozone,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "ozone",x_ave,x_std,x_min,x_max END IF ! On lit l'ozone directement sur le histmth.nc ! CALL ozonecm(rjour, rlatfi, paprsfi, ozone) IF (debug) THEN PRINT *,'klon',klon CALL cstat(klon*klev,ozone,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "ozone",x_ave,x_std,x_min,x_max END IF IF (debug) THEN WRITE (*,*) "ngridmx",ngridmx CALL cstat(ngridmx,tsolfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tsol",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,rlonfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "rlon",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,rlatfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "rlat",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,phisfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "phis",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,airefi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "aire",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,albsfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "albs",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*(llm+1),paprsfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "paprs",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,pplayfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "pplay",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,tfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "temp",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,qfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "ovap",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,cldfrafi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "cldfra",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,cldliqfi,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "cldliq",x_ave,x_std,x_min,x_max CALL cstat(ngridmx*llm,ozone,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "ozone",x_ave,x_std,x_min,x_max 9002 FORMAT (1x,A12,10(1pE13.6)) END IF if(m.eq.1)then #include "ini_histforcing.h" endif c heat_ref(:,:) = 0. heat0_ref(:,:) = 0. cool_ref(:,:) = 0. cool0_ref(:,:) = 0. ! d_heat_ini(:,:) = 0. d_heat0_ini(:,:) = 0. d_cool_ini(:,:) = 0. d_cool0_ini(:,:) = 0. ! d_heat_adj(:,:) = 0. d_heat0_adj(:,:) = 0. d_cool_adj(:,:) = 0. d_cool0_adj(:,:) = 0. ! CALL rforcing(m,rjour,read_climoz, $ tfi,qfi,ozone,ozone_daylight, $ ozone_ref,ozone_daylight_ref, $ pplayfi,paprsfi,cldfrafi,cldliqfi, $ tsolfi,albsfi,rlatfi, c outputs : $ tfi_adj, $ tps_sw_ref,tps_sw_ref0,tps_lw_ref,tps_lw_ref0, $ tps_sw_ini,tps_sw_ini0,tps_lw_ini,tps_lw_ini0, $ d_tps_sw_ini,d_tps_sw_ini0,d_tps_lw_ini,d_tps_lw_ini0, $ d_tps_sw_adj,d_tps_sw_adj0,d_tps_lw_adj,d_tps_lw_adj0, $ toa_sw_ref,toa_sw_ref0,toa_lw_ref,toa_lw_ref0, $ toa_sw_ini,toa_sw_ini0,toa_lw_ini,toa_lw_ini0, $ d_toa_sw_ini,d_toa_sw_ini0,d_toa_lw_ini,d_toa_lw_ini0, $ d_toa_sw_adj,d_toa_sw_adj0,d_toa_lw_adj,d_toa_lw_adj0, $ srf_sw_ref,srf_sw_ref0,srf_lw_ref,srf_lw_ref0, $ d_srf_sw_adj,d_srf_sw_adj0,d_srf_lw_adj,d_srf_lw_adj0, $ dHrad_dT,bilq_ref,bilq_ini,bilq_adj, $ heat_ref, heat0_ref, cool_ref, cool0_ref, $ d_heat_ini, d_heat0_ini, d_cool_ini, d_cool0_ini, $ d_heat_adj, d_heat0_adj, d_cool_adj, d_cool0_adj ) C IF (debug) THEN CALL cstat(ngridmx,toa_sw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_sw_ref",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,toa_lw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_lw_ref",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_sw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_sw_ref",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_lw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_lw_ref",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,srf_sw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "srf_sw_ref",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,srf_lw_ref,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "srf_lw_ref",x_ave,x_std,x_min,x_max ! CALL cstat(ngridmx,toa_sw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_sw_ref0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,toa_lw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_lw_ref0",x_ave,x_std,x_min,x_max CALL cwstat(ngridmx,toa_lw_ref0,airefi,x_ave,x_std,x_min,x_max $ ,undef) WRITE (*,9002) "Atoa_lw_ref0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_sw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_sw_ref0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_lw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_lw_ref0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,srf_sw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "srf_sw_ref0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,srf_lw_ref0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "srf_lw_ref0",x_ave,x_std,x_min,x_max ! WRITE (*,*) ! CALL cstat(ngridmx,toa_sw_ini,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_sw_ini",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,toa_lw_ini,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_lw_ini",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_sw_ini,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_sw_ini",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_lw_ini,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_lw_ini",x_ave,x_std,x_min,x_max ! CALL cstat(ngridmx,toa_sw_ini0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_sw_ini0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,toa_lw_ini0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "toa_lw_ini0",x_ave,x_std,x_min,x_max CALL cwstat(ngridmx,toa_lw_ini0,airefi,x_ave,x_std,x_min,x_max $ ,undef) WRITE (*,9002) "Atoa_lw_ini0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_sw_ini0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_sw_ini0",x_ave,x_std,x_min,x_max CALL cstat(ngridmx,tps_lw_ini0,x_ave,x_std,x_min,x_max,undef) WRITE (*,9002) "tps_lw_ini0",x_ave,x_std,x_min,x_max ! CALL cwstat(ngridmx,d_toa_lw_ini0,airefi,x_ave,x_std,x_min,x_max $ ,undef) WRITE (*,9002) "d_toa_lw_ini0",x_ave,x_std,x_min,x_max END IF #include "write_histforcing.h" C C Diagnostiques en moyenne sur le globe aire_tot = 0. DO n =1, ngridmx aire_tot=aire_tot + airefi(n) END DO DO n =1, ngridmx C Flux au sommet de l'atmosphère toa_sw_ref_m(m) = toa_sw_ref_m(m) + toa_sw_ref(n) $ *airefi(n)/aire_tot toa_sw_ref0_m(m) = toa_sw_ref0_m(m) + toa_sw_ref0(n) $ *airefi(n)/aire_tot toa_lw_ref_m(m) = toa_lw_ref_m(m) + toa_lw_ref(n) $ *airefi(n)/aire_tot toa_lw_ref0_m(m) = toa_lw_ref0_m(m) + toa_lw_ref0(n) $ *airefi(n)/aire_tot C Forcage initial au sommet de l'atm d_toa_sw_ini_m(m) = d_toa_sw_ini_m(m) + d_toa_sw_ini(n) $ *airefi(n)/aire_tot d_toa_sw_ini0_m(m) = d_toa_sw_ini0_m(m) + d_toa_sw_ini0(n) $ *airefi(n)/aire_tot d_toa_lw_ini_m(m) = d_toa_lw_ini_m(m) + d_toa_lw_ini(n) $ *airefi(n)/aire_tot d_toa_lw_ini0_m(m) = d_toa_lw_ini0_m(m) + d_toa_lw_ini0(n) $ *airefi(n)/aire_tot C Forcage ajuste au sommet de l'atm d_toa_sw_adj_m(m) = d_toa_sw_adj_m(m) + d_toa_sw_adj(n) $ *airefi(n)/aire_tot d_toa_sw_adj0_m(m) = d_toa_sw_adj0_m(m) + d_toa_sw_adj0(n) $ *airefi(n)/aire_tot d_toa_lw_adj_m(m) = d_toa_lw_adj_m(m) + d_toa_lw_adj(n) $ *airefi(n)/aire_tot d_toa_lw_adj0_m(m) = d_toa_lw_adj0_m(m) + d_toa_lw_adj0(n) $ *airefi(n)/aire_tot C Flux a la tropopause tps_sw_ref_m(m) = tps_sw_ref_m(m) + tps_sw_ref(n) $ *airefi(n)/aire_tot tps_sw_ref0_m(m) = tps_sw_ref0_m(m) + tps_sw_ref0(n) $ *airefi(n)/aire_tot tps_lw_ref_m(m) = tps_lw_ref_m(m) + tps_lw_ref(n) $ *airefi(n)/aire_tot tps_lw_ref0_m(m) = tps_lw_ref0_m(m) + tps_lw_ref0(n) $ *airefi(n)/aire_tot C Forcage initial a la tropopause d_tps_sw_ini_m(m) = d_tps_sw_ini_m(m) + d_tps_sw_ini(n) $ *airefi(n)/aire_tot d_tps_sw_ini0_m(m) = d_tps_sw_ini0_m(m) + d_tps_sw_ini0(n) $ *airefi(n)/aire_tot d_tps_lw_ini_m(m) = d_tps_lw_ini_m(m) + d_tps_lw_ini(n) $ *airefi(n)/aire_tot d_tps_lw_ini0_m(m) = d_tps_lw_ini0_m(m) + d_tps_lw_ini0(n) $ *airefi(n)/aire_tot C Forcage ajuste a la tropopause d_tps_sw_adj_m(m) = d_tps_sw_adj_m(m) + d_tps_sw_adj(n) $ *airefi(n)/aire_tot d_tps_sw_adj0_m(m) = d_tps_sw_adj0_m(m) + d_tps_sw_adj0(n) $ *airefi(n)/aire_tot d_tps_lw_adj_m(m) = d_tps_lw_adj_m(m) + d_tps_lw_adj(n) $ *airefi(n)/aire_tot d_tps_lw_adj0_m(m) = d_tps_lw_adj0_m(m) + d_tps_lw_adj0(n) $ *airefi(n)/aire_tot C Flux a la surface srf_sw_ref_m(m) = srf_sw_ref_m(m) + srf_sw_ref(n) $ *airefi(n)/aire_tot srf_sw_ref0_m(m) = srf_sw_ref0_m(m) + srf_sw_ref0(n) $ *airefi(n)/aire_tot srf_lw_ref_m(m) = srf_lw_ref_m(m) + srf_lw_ref(n) $ *airefi(n)/aire_tot srf_lw_ref0_m(m) = srf_lw_ref0_m(m) + srf_lw_ref0(n) $ *airefi(n)/aire_tot C Forcage ajuste a la surface d_srf_sw_adj_m(m) = d_srf_sw_adj_m(m) + d_srf_sw_adj(n) $ *airefi(n)/aire_tot d_srf_sw_adj0_m(m) = d_srf_sw_adj0_m(m) + d_srf_sw_adj0(n) $ *airefi(n)/aire_tot d_srf_lw_adj_m(m) = d_srf_lw_adj_m(m) + d_srf_lw_adj(n) $ *airefi(n)/aire_tot d_srf_lw_adj0_m(m) = d_srf_lw_adj0_m(m) + d_srf_lw_adj0(n) $ *airefi(n)/aire_tot C Bilan radiatif de la stratosphere bilq_ref_m(m) = bilq_ref_m(m) + bilq_ref(n) $ *airefi(n)/aire_tot bilq_ini_m(m) = bilq_ini_m(m) + bilq_ini(n) $ *airefi(n)/aire_tot bilq_adj_m(m) = bilq_adj_m(m) + bilq_adj(n) $ *airefi(n)/aire_tot C END DO CALL cwstat(ngridmx,d_toa_lw_ini0,airefi,x_ave,x_std,x_min,x_max $ ,undef) d_toa_lw_ini0_m(m) = x_ave 99999 CONTINUE DO m =1, mois C Flux au sommet de l'atmosphère toa_sw_ref_yr = toa_sw_ref_yr + toa_sw_ref_m(m) $ / FLOAT(mois) toa_sw_ref0_yr = toa_sw_ref0_yr + toa_sw_ref0_m(m) $ / FLOAT(mois) toa_lw_ref_yr = toa_lw_ref_yr + toa_lw_ref_m(m) $ / FLOAT(mois) toa_lw_ref0_yr = toa_lw_ref0_yr + toa_lw_ref0_m(m) $ / FLOAT(mois) C Forcage initial au sommet de l'atm d_toa_sw_ini_yr = d_toa_sw_ini_yr + d_toa_sw_ini_m(m) $ / FLOAT(mois) d_toa_sw_ini0_yr = d_toa_sw_ini0_yr + d_toa_sw_ini0_m(m) $ / FLOAT(mois) d_toa_lw_ini_yr = d_toa_lw_ini_yr + d_toa_lw_ini_m(m) $ / FLOAT(mois) d_toa_lw_ini0_yr = d_toa_lw_ini0_yr + d_toa_lw_ini0_m(m) $ / FLOAT(mois) C Forcage ajuste au sommet de l'atm d_toa_sw_adj_yr = d_toa_sw_adj_yr + d_toa_sw_adj_m(m) $ / FLOAT(mois) d_toa_sw_adj0_yr = d_toa_sw_adj0_yr + d_toa_sw_adj0_m(m) $ / FLOAT(mois) d_toa_lw_adj_yr = d_toa_lw_adj_yr + d_toa_lw_adj_m(m) $ / FLOAT(mois) d_toa_lw_adj0_yr = d_toa_lw_adj0_yr + d_toa_lw_adj0_m(m) $ / FLOAT(mois) C Flux a la tropopause tps_sw_ref_yr = tps_sw_ref_yr + tps_sw_ref_m(m) $ / FLOAT(mois) tps_sw_ref0_yr = tps_sw_ref0_yr + tps_sw_ref0_m(m) $ / FLOAT(mois) tps_lw_ref_yr = tps_lw_ref_yr + tps_lw_ref_m(m) $ / FLOAT(mois) tps_lw_ref0_yr = tps_lw_ref0_yr + tps_lw_ref0_m(m) $ / FLOAT(mois) C Forcage initial a la tropopause d_tps_sw_ini_yr = d_tps_sw_ini_yr + d_tps_sw_ini_m(m) $ / FLOAT(mois) d_tps_sw_ini0_yr = d_tps_sw_ini0_yr + d_tps_sw_ini0_m(m) $ / FLOAT(mois) d_tps_lw_ini_yr = d_tps_lw_ini_yr + d_tps_lw_ini_m(m) $ / FLOAT(mois) d_tps_lw_ini0_yr = d_tps_lw_ini0_yr + d_tps_lw_ini0_m(m) $ / FLOAT(mois) C Forcage ajuste a la tropopause d_tps_sw_adj_yr = d_tps_sw_adj_yr + d_tps_sw_adj_m(m) $ / FLOAT(mois) d_tps_sw_adj0_yr = d_tps_sw_adj0_yr + d_tps_sw_adj0_m(m) $ / FLOAT(mois) d_tps_lw_adj_yr = d_tps_lw_adj_yr + d_tps_lw_adj_m(m) $ / FLOAT(mois) d_tps_lw_adj0_yr = d_tps_lw_adj0_yr + d_tps_lw_adj0_m(m) $ / FLOAT(mois) C Flux a la surface srf_sw_ref_yr = srf_sw_ref_yr + srf_sw_ref_m(m) $ / FLOAT(mois) srf_sw_ref0_yr = srf_sw_ref0_yr + srf_sw_ref0_m(m) $ / FLOAT(mois) srf_lw_ref_yr = srf_lw_ref_yr + srf_lw_ref_m(m) $ / FLOAT(mois) srf_lw_ref0_yr = srf_lw_ref0_yr + srf_lw_ref0_m(m) $ / FLOAT(mois) C Forcage ajuste a la surface d_srf_sw_adj_yr = d_srf_sw_adj_yr + d_srf_sw_adj_m(m) $ / FLOAT(mois) d_srf_sw_adj0_yr = d_srf_sw_adj0_yr + d_srf_sw_adj0_m(m) $ / FLOAT(mois) d_srf_lw_adj_yr = d_srf_lw_adj_yr + d_srf_lw_adj_m(m) $ / FLOAT(mois) d_srf_lw_adj0_yr = d_srf_lw_adj0_yr + d_srf_lw_adj0_m(m) $ / FLOAT(mois) END DO ! ! Diagnostiques en moyenne mensuelle ! 8001 FORMAT (1x,A10,12(F13.3)) WRITE (*,*) 'Stratosphrere radiative budget' WRITE (*,8001) 'Ref :', $ (bilq_ref_m(m),m=1,mois) WRITE (*,8001) 'Ini :', $ (bilq_ini_m(m),m=1,mois) WRITE (*,8001) 'Adj :', $ (bilq_adj_m(m),m=1,mois) WRITE (*,8001) 'Diff :', $ (bilq_adj_m(m)-bilq_ref_m(m),m=1,mois) ! WRITE (*,*) 'Forcing, adjusted, all sky' WRITE (*,8001) 'TOA SW ', $ (d_toa_sw_adj_m(m),m=1,mois) WRITE (*,8001) 'TOA LW ', $ (d_toa_lw_adj_m(m),m=1,mois) WRITE (*,8001) 'TOA NET', $ ((d_toa_sw_adj_m(m)+d_toa_lw_adj_m(m)),m=1,mois) WRITE (*,8001) 'TPS SW ', $ (d_tps_sw_adj_m(m),m=1,mois) WRITE (*,8001) 'TPS LW ', $ (d_tps_lw_adj_m(m),m=1,mois) WRITE (*,8001) 'TPS NET', $ ((d_tps_sw_adj_m(m)+d_tps_lw_adj_m(m)),m=1,mois) WRITE (*,8001) 'SRF SW ', $ (d_srf_sw_adj_m(m),m=1,mois) WRITE (*,8001) 'SRF LW ', $ (d_srf_lw_adj_m(m),m=1,mois) WRITE (*,8001) 'SRF NET', $ ((d_srf_sw_adj_m(m)+d_srf_lw_adj_m(m)),m=1,mois) ! ! Diagnostiques en moyenne annuelle ! 9000 FORMAT (1x,A18,3(A15)) C 9001 FORMAT (1x,3A9,3(1pEN15.6)) 9001 FORMAT (1x,A9,A5,A9,3(F13.3)) WRITE (*,*) WRITE (*,9000) ' ','SW','LW','NET' WRITE (*,9001) 'Bilan','TOA','All sky' $ ,toa_sw_ref_yr, toa_lw_ref_yr, toa_sw_ref_yr + toa_lw_ref_yr WRITE (*,9001) 'Bilan','TPS','All sky' $ ,tps_sw_ref_yr, tps_lw_ref_yr, tps_sw_ref_yr + tps_lw_ref_yr WRITE (*,9001) 'Bilan','SRF','All sky' $ ,srf_sw_ref_yr, srf_lw_ref_yr, srf_sw_ref_yr + srf_lw_ref_yr WRITE (*,*) WRITE (*,9001) 'Ini Forc','TOA','All sky', d_toa_sw_ini_yr $ , d_toa_lw_ini_yr, d_toa_sw_ini_yr + d_toa_lw_ini_yr WRITE (*,9001) 'Adj Forc','TOA','All sky', d_toa_sw_adj_yr $ , d_toa_lw_adj_yr, d_toa_sw_adj_yr + d_toa_lw_adj_yr WRITE (*,*) WRITE (*,9001) 'Ini Forc','TPS','All sky', d_tps_sw_ini_yr $ , d_tps_lw_ini_yr, d_tps_sw_ini_yr + d_tps_lw_ini_yr WRITE (*,9001) 'Adj Forc','TPS','All sky', d_tps_sw_adj_yr $ , d_tps_lw_adj_yr, d_tps_sw_adj_yr + d_tps_lw_adj_yr WRITE (*,*) WRITE (*,9001) 'Adj Forc','SRF','All sky', d_srf_sw_adj_yr $ , d_srf_lw_adj_yr, d_srf_sw_adj_yr + d_srf_lw_adj_yr WRITE (*,*) '-----------------------------' WRITE (*,9001) 'Bilan','TOA','Clr sky' $ ,toa_sw_ref0_yr, toa_lw_ref0_yr, toa_sw_ref0_yr + toa_lw_ref0_yr WRITE (*,9001) 'Bilan','TPS','Clr sky' $ ,tps_sw_ref0_yr, tps_lw_ref0_yr, tps_sw_ref0_yr + tps_lw_ref0_yr WRITE (*,9001) 'Bilan','SRF','Clr sky' $ ,srf_sw_ref0_yr, srf_lw_ref0_yr, srf_sw_ref0_yr + srf_lw_ref0_yr WRITE (*,*) WRITE (*,9001) 'Ini Forc','TOA','Clr sky', d_toa_sw_ini0_yr $ , d_toa_lw_ini0_yr, d_toa_sw_ini0_yr + d_toa_lw_ini0_yr WRITE (*,9001) 'Adj Forc','TOA','Clr sky', d_toa_sw_adj0_yr $ , d_toa_lw_adj0_yr, d_toa_sw_adj0_yr + d_toa_lw_adj0_yr WRITE (*,*) WRITE (*,9001) 'Ini Forc','TPS','Clr sky', d_tps_sw_ini0_yr $ , d_tps_lw_ini0_yr, d_tps_sw_ini0_yr + d_tps_lw_ini0_yr WRITE (*,9001) 'Adj Forc','TPS','Clr sky', d_tps_sw_adj0_yr $ , d_tps_lw_adj0_yr, d_tps_sw_adj0_yr + d_tps_lw_adj0_yr WRITE (*,*) WRITE (*,9001) 'Adj Forc','SRF','Clr sky', d_srf_sw_adj0_yr $ , d_srf_lw_adj0_yr, d_srf_sw_adj0_yr + d_srf_lw_adj0_yr c STOP END C