source: LMDZ5/trunk/libf/cosp/cosp_output_mod.F90 @ 2106

Last change on this file since 2106 was 2080, checked in by idelkadi, 10 years ago
  • Rajout des derictives OPENMP pour lire les fichiers namelists
  • Corrections dans la re-ecriture des sorties (traitement des valeurs indefinies)
  • Suppression des parametres non utilises des namelists
File size: 10.6 KB
RevLine 
[1926]1! A.Idelkadi sept 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2!! Module pour declarer et initialiser les parametres de controle des fichiers de sorties et des champs a sortir
3!! La routine cosp_output_open (appelee 1 seule fois dans phy_cosp.F90) permet :
4!! de creer les fichiers avec leurs grilles horizontales et verticales
5!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
6  MODULE cosp_output_mod
7
8  USE MOD_COSP_CONSTANTS
9  USE MOD_COSP_TYPES
10
11! cosp_output_mod
12      INTEGER, PRIVATE             :: i
13!!!!!!! Controle des fichier de sorties Cosp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
14      LOGICAL, DIMENSION(3), SAVE  :: cosp_outfilekeys
15      INTEGER, DIMENSION(3), SAVE  :: cosp_nidfiles
16!$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles)
17      INTEGER, DIMENSION(3), SAVE  :: nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp
18      REAL, DIMENSION(3), SAVE                :: zoutm_cosp
19!$OMP THREADPRIVATE(nhori, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp, zoutm_cosp)
20      REAL, SAVE                   :: zdtimemoy_cosp
21!$OMP THREADPRIVATE(zdtimemoy_cosp)
22      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfiletypes
23      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfilenames
24      REAL, DIMENSION(3), SAVE               :: cosp_ecritfiles
25!$OMP THREADPRIVATE(cosp_outfiletypes, cosp_outfilenames, cosp_ecritfiles)
26
27!!!!  Controle des variables a sortir dans les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28  TYPE ctrl_outcosp
29     LOGICAL,DIMENSION(3)                 :: cles             !!! Sortir ou non le champs
30     CHARACTER(len=20)                    :: name       
31     CHARACTER(len=150)                   :: description      !!! Nom
32     CHARACTER(len=20)                    :: unit             !!! Unite
33     CHARACTER(len=20),DIMENSION(3)  :: cosp_typeecrit        !!! Operation (ave, inst, ...)
34  END TYPE ctrl_outcosp
35! CALIPSO vars
36  TYPE(ctrl_outcosp), SAVE :: o_cllcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
37         "cllcalipso", "Lidar Low-level Cloud Fraction", "1", (/ ('', i=1, 3) /))                                   
38  TYPE(ctrl_outcosp), SAVE :: o_clmcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
39         "clmcalipso", "Lidar Mid-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
40  TYPE(ctrl_outcosp), SAVE :: o_clhcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
41         "clhcalipso", "Lidar Hight-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
42  TYPE(ctrl_outcosp), SAVE :: o_cltcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
43         "cltcalipso", "Lidar Total Cloud Fraction", "1", (/ ('', i=1, 3) /))
44  TYPE(ctrl_outcosp), SAVE :: o_clcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
45         "clcalipso", "Lidar Cloud Fraction (532 nm)", "1", (/ ('', i=1, 3) /))
46  TYPE(ctrl_outcosp), SAVE :: o_cfad_lidarsr532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
47         "cfad_lidarsr532", "Lidar Scattering Ratio CFAD (532 nm)", "1", (/ ('', i=1, 3) /))   
48  TYPE(ctrl_outcosp), SAVE :: o_parasol_refl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
49         "parasol_refl", "PARASOL-like mono-directional reflectance","1", (/ ('', i=1, 3) /))
50  TYPE(ctrl_outcosp), SAVE :: o_parasol_crefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &             
51         "parasol_crefl", "PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))                 
52  TYPE(ctrl_outcosp), SAVE :: o_atb532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
53         "atb532", "Lidar Attenuated Total Backscatter (532 nm)","1", (/ ('', i=1, 3) /))
54  TYPE(ctrl_outcosp), SAVE :: o_beta_mol532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
55         "beta_mol532", "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", (/ ('', i=1, 3) /))
56! ISCCP vars
57  TYPE(ctrl_outcosp), SAVE :: o_sunlit = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
58         "sunlit", "1 for day points, 0 for nightime","1",(/ ('', i=1, 3) /))                   
59  TYPE(ctrl_outcosp), SAVE :: o_clisccp2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
60         "clisccp2", "Cloud Fraction as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
61  TYPE(ctrl_outcosp), SAVE :: o_boxtauisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
62         "boxtauisccp", "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
63  TYPE(ctrl_outcosp), SAVE :: o_boxptopisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
64         "boxptopisccp", "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", (/ ('', i=1, 3) /))
65  TYPE(ctrl_outcosp), SAVE :: o_tclisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
66          "tclisccp", "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
67  TYPE(ctrl_outcosp), SAVE :: o_ctpisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
68          "ctpisccp", "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", (/ ('', i=1, 3) /))
69  TYPE(ctrl_outcosp), SAVE :: o_tauisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
70          "tauisccp", "Optical Depth as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
71  TYPE(ctrl_outcosp), SAVE :: o_albisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
72          "albisccp", "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
73  TYPE(ctrl_outcosp), SAVE :: o_meantbisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
74          "meantbisccp", " Mean all-sky 10.5 micron brightness temperature as calculated &
75           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
76  TYPE(ctrl_outcosp), SAVE :: o_meantbclrisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
77          "meantbclrisccp", "Mean clear-sky 10.5 micron brightness temperature as calculated &
78           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
79
80!   LOGICAL, SAVE :: cosp_varsdefined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL
81  LOGICAL, SAVE        :: cosp_varsdefined
82
83CONTAINS
84
85!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
86!!!!!!!!! Ouverture des fichier et definition des  axes!!!!!!!!
87  !! histbeg, histvert
88!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
89
90  SUBROUTINE cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
91                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, &
92                              ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)
93
94
95  USE iophy
96  USE ioipsl
97  USE phys_cal_mod
98
99#ifdef CPP_XIOS
100    ! ug Pour les sorties XIOS
101    USE wxios
102#endif
103
104  IMPLICIT NONE
105
106!!! Variables d'entree
107  integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
108  real,dimension(Nlevlmdz) :: presnivs
109  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth
110  logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, use_vgrid                   
111  type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats
112
113!!! Variables locales
114  integer                  :: idayref, iff, ii
115  real                     :: zjulian
116  real,dimension(Ncolumns) :: column_ax
117
118!!! Variables d'entree
119  include "temps.h"
120  INCLUDE 'iniprint.h'
121
122#ifdef CPP_XIOS
123    ! ug Variables utilisées pour récupérer le calendrier pour xios
124    INTEGER :: x_an, x_mois, x_jour
125    REAL :: x_heure
126#endif
127
128    WRITE(lunout,*) 'Debut cosp_output_mod.F90'
129    ! Initialisations (Valeurs par defaut)
130
131    do ii=1,Ncolumns
132      column_ax(ii) = real(ii)
133    enddo
134
135
136    cosp_outfilenames(1) = 'histmthCOSP'
137    cosp_outfilenames(2) = 'histdayCOSP'
138    cosp_outfilenames(3) = 'histhfCOSP'
139
140    cosp_outfiletypes(1) = 'ave(X)'
141    cosp_outfiletypes(2) = 'ave(X)'
142    cosp_outfiletypes(3) = 'ave(X)'
143
144    cosp_outfilekeys(1) = ok_mensuelCOSP
145    cosp_outfilekeys(2) = ok_journeCOSP
146    cosp_outfilekeys(3) = ok_hfCOSP
147
148    cosp_ecritfiles(1) = mth_len*86400.
149    cosp_ecritfiles(2) = 1.*86400.
150    cosp_ecritfiles(3) = 0.125*86400.
151
152! Lecture des parametres dans output.def ou config.def
153
154    CALL getin('cosp_outfilenames',cosp_outfilenames)
155    CALL getin('cosp_outfilekeys',cosp_outfilekeys)
156    CALL getin('cosp_outfiletimesteps',cosp_ecritfiles)
157    CALL getin('cosp_outfiletypes',cosp_outfiletypes)
158
159    WRITE(lunout,*)'cosp_outfilenames=',cosp_outfilenames
160    WRITE(lunout,*)'cosp_outfilekeys=',cosp_outfilekeys
161    WRITE(lunout,*)'cosp_outfiletimesteps=',cosp_ecritfiles
162    WRITE(lunout,*)'cosp_outfiletypes=',cosp_outfiletypes
163 
164#ifdef CPP_XIOS
165    ! ug Réglage du calendrier xios
166    !Temps julian => an, mois, jour, heure
167    CALL ymds2ju(annee_ref, 1, day_ref, 0.0, zjulian)
168    CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
169    CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure)
170#endif
171   
172    zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne
173
174    DO iff=1,3
175       zoutm_cosp(iff) = cosp_ecritfiles(iff) ! Frequence ou l on ecrit en seconde
176
177       IF (cosp_outfilekeys(iff)) THEN
178           idayref = day_ref
179           CALL ymds2ju(annee_ref, 1, idayref, 0., zjulian)
180           CALL histbeg_phy(cosp_outfilenames(iff),itau_phy,zjulian,&
181             dtime,nhoricosp(iff),cosp_nidfiles(iff))
182
183! Definition de l'axe vertical
184       if (use_vgrid) then
185! Axe vertical Cosp 40 niveaux (en m)
[2080]186      CALL histvert(cosp_nidfiles(iff),"height","height","m",vgrid%Nlvgrid,vgrid%z,nvert(iff))
[1926]187       else
188! Axe vertical modele LMDZ presnivs
[2080]189      CALL histvert(cosp_nidfiles(iff),"presnivs","Vertical levels","Pa",vgrid%Nlvgrid,presnivs,nvert(iff),"down")
[1926]190       endif
191! Axe vertical niveaux modele (en m)
192      CALL histvert(cosp_nidfiles(iff),"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertmcosp(iff))
193
194      CALL histvert(cosp_nidfiles(iff),"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp(iff))
195
196      CALL histvert(cosp_nidfiles(iff),"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp(iff),"down")
197
198      CALL histvert(cosp_nidfiles(iff),"column","column","count",Ncolumns,column_ax(1:Ncolumns),nvertcol(iff))
199
200#ifdef CPP_XIOS
201    ! ug déclaration des axes verticaux de chaque fichier:
202    if (use_vgrid) then
[2080]203      CALL wxios_add_vaxis("height", cosp_outfilenames(iff), vgrid%Nlvgrid, vgrid%z)
[1926]204    else
[2080]205      CALL wxios_add_vaxis("presnivs", cosp_outfilenames(iff), vgrid%Nlvgrid, presnivs)
[1926]206    endif
[1986]207    CALL wxios_add_vaxis("height_mlev", cosp_outfilenames(iff), Nlevlmdz, vgrid%mz)
208    CALL wxios_add_vaxis("sza", cosp_outfilenames(iff), PARASOL_NREFL, PARASOL_SZA)
209    CALL wxios_add_vaxis("pressure2", cosp_outfilenames(iff), 7, ISCCP_PC)
210    CALL wxios_add_vaxis("column", cosp_outfilenames(iff), Ncolumns, column_ax)
[1926]211#endif
212
213      ENDIF
214  ENDDO
215
216    end SUBROUTINE cosp_output_open
217
218 END MODULE cosp_output_mod
Note: See TracBrowser for help on using the repository browser.