source: LMDZ5/branches/testing/libf/phylmd/cosp/cosp_output_write_mod.F90 @ 2488

Last change on this file since 2488 was 2488, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2457:2487 into testing branch

File size: 24.4 KB
Line 
1!!!! Abderrahmane Idelkadi aout 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2! Module pour definir (au 1er appel) et ecrire les variables dans les fichiers de sortie cosp
3!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4   MODULE cosp_output_write_mod
5 
6   USE cosp_output_mod
7 
8   INTEGER, SAVE  :: itau_iocosp
9!$OMP THREADPRIVATE(itau_iocosp)
10   INTEGER, save        :: Nlevout, Ncolout
11!$OMP THREADPRIVATE(Nlevout, Ncolout)
12
13!  INTERFACE histwrite_cosp
14!    MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp
15!  END INTERFACE
16
17   CONTAINS
18
19  SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, &
20                               cfg, gbx, vgrid, sglidar, sgradar, stlidar, stradar, &
21                               isccp, misr, modis)
22
23    USE ioipsl
24    USE time_phylmdz_mod, ONLY: itau_phy, start_time, day_step_phy
25    USE print_control_mod, ONLY: lunout,prt_level
26
27#ifdef CPP_XIOS
28    USE wxios, only: wxios_closedef
29    USE xios, only: xios_update_calendar
30#endif
31
32!!! Variables d'entree
33  integer               :: itap, Nlevlmdz, Ncolumns, Npoints
34  real                  :: freq_COSP, dtime
35  type(cosp_config)     :: cfg     ! Control outputs
36  type(cosp_gridbox)    :: gbx     ! Gridbox information. Input for COSP
37  type(cosp_sglidar)    :: sglidar ! Output from lidar simulator
38  type(cosp_sgradar)    :: sgradar ! Output from radar simulator
39  type(cosp_isccp)      :: isccp   ! Output from ISCCP simulator
40  type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
41  type(cosp_radarstats) :: stradar
42  type(cosp_misr)       :: misr    ! Output from MISR
43  type(cosp_modis)      :: modis   ! Outputs from Modis
44  type(cosp_vgrid)      :: vgrid   ! Information on vertical grid of stats
45
46!!! Variables locales
47  integer               :: icl
48  logical               :: ok_sync
49  integer               :: itau_wcosp
50  real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
51
52  Nlevout = vgrid%Nlvgrid
53  Ncolout = Ncolumns
54
55! A refaire
56       itau_wcosp = itau_phy + itap + start_time * day_step_phy
57        if (prt_level >= 10) then
58             WRITE(lunout,*)'itau_wcosp, itap, start_time, day_step_phy =', &
59                             itau_wcosp, itap, start_time, day_step_phy
60        endif
61
62! On le donne a  cosp_output_write_mod pour que les histwrite y aient acces:
63       CALL set_itau_iocosp(itau_wcosp)
64        if (prt_level >= 10) then
65              WRITE(lunout,*)'itau_iocosp =',itau_iocosp
66        endif
67
68    ok_sync = .TRUE.
69   
70!DO iinit=1, iinitend
71! AI sept 2014 cette boucle supprimee
72! On n'ecrit pas quand itap=1 (cosp)
73
74   if (prt_level >= 10) then
75         WRITE(lunout,*)'DO iinit=1, iinitend ',iinitend
76   endif
77
78!#ifdef CPP_XIOS
79! !$OMP MASTER
80!IF (cosp_varsdefined) THEN
81!   if (prt_level >= 10) then
82!         WRITE(lunout,*)'Apell xios_update_calendar cosp_varsdefined iinitend ', &
83!                         cosp_varsdefined,iinitend
84!   endif
85!    CALL xios_update_calendar(itau_wcosp)
86!ENDIF
87!  !$OMP END MASTER
88!  !$OMP BARRIER
89!#endif
90
91 if (cfg%Llidar_sim) then
92! Pb des valeurs indefinies, on les met a 0
93! A refaire proprement
94  do k = 1,Nlevout
95     do ip = 1,Npoints
96     if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
97      stlidar%lidarcld(ip,k)=Cosp_fill_value
98     endif
99     enddo
100
101     do ii= 1,SR_BINS
102      do ip = 1,Npoints
103       if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
104        stlidar%cfad_sr(ip,ii,k)=Cosp_fill_value
105       endif
106      enddo
107     enddo
108   enddo
109
110  do ip = 1,Npoints
111   do k = 1,Nlevlmdz
112     if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
113      sglidar%beta_mol(ip,k)=Cosp_fill_value
114     endif
115
116     do ii= 1,Ncolumns
117       if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
118        sglidar%beta_tot(ip,ii,k)=Cosp_fill_value
119       endif
120     enddo
121
122    enddo    !k = 1,Nlevlmdz
123   enddo     !ip = 1,Npoints
124
125   do k = 1,LIDAR_NCAT
126    do ip = 1,Npoints
127     if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
128      stlidar%cldlayer(ip,k)=Cosp_fill_value
129     endif
130    enddo
131   enddo
132
133! AI 11 / 2015
134
135   where(stlidar%parasolrefl == R_UNDEF) stlidar%parasolrefl = 0.0
136   where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = 0.0
137   where(stlidar%cldlayerphase == R_UNDEF) stlidar%cldlayerphase = 0.0
138   where(stlidar%lidarcldphase == R_UNDEF) stlidar%lidarcldphase = 0.0
139   where(stlidar%lidarcldtmp == R_UNDEF) stlidar%lidarcldtmp = 0.0
140   
141
142   print*,'Appel histwrite2d_cosp'
143   CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
144   CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
145   CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
146   CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
147   CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
148   CALL histwrite3d_cosp(o_clcalipsotmp,stlidar%lidarcldtmp(:,:,1),nverttemp)
149
150   CALL histwrite2d_cosp(o_cllcalipsoice,stlidar%cldlayerphase(:,1,1))
151   CALL histwrite2d_cosp(o_clhcalipsoice,stlidar%cldlayerphase(:,3,1))
152   CALL histwrite2d_cosp(o_clmcalipsoice,stlidar%cldlayerphase(:,2,1))
153   CALL histwrite2d_cosp(o_cltcalipsoice,stlidar%cldlayerphase(:,4,1))
154   CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,1),nvert)
155   CALL histwrite3d_cosp(o_clcalipsotmpice,stlidar%lidarcldtmp(:,:,2),nverttemp)
156
157   CALL histwrite2d_cosp(o_cllcalipsoliq,stlidar%cldlayerphase(:,1,2))
158   CALL histwrite2d_cosp(o_clhcalipsoliq,stlidar%cldlayerphase(:,3,2))
159   CALL histwrite2d_cosp(o_clmcalipsoliq,stlidar%cldlayerphase(:,2,2))
160   CALL histwrite2d_cosp(o_cltcalipsoliq,stlidar%cldlayerphase(:,4,2))
161   CALL histwrite3d_cosp(o_clcalipsoliq,stlidar%lidarcldphase(:,:,2),nvert)
162   CALL histwrite3d_cosp(o_clcalipsotmpliq,stlidar%lidarcldtmp(:,:,3),nverttemp)
163
164   CALL histwrite2d_cosp(o_cllcalipsoun,stlidar%cldlayerphase(:,1,3))
165   CALL histwrite2d_cosp(o_clhcalipsoun,stlidar%cldlayerphase(:,3,3))
166   CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3))
167   CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3))
168   CALL histwrite3d_cosp(o_clcalipsoun,stlidar%lidarcldphase(:,:,3),nvert)
169   CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp)
170
171   do icl=1,SR_BINS
172      CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
173   enddo
174
175   CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
176
177   do k=1,PARASOL_NREFL
178    do ip=1, Npoints
179     if (stlidar%cldlayer(ip,4).gt.0.01) then
180       parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
181                            stlidar%cldlayer(ip,4)
182        Ncref(ip,k) = 1.
183     else
184        parasolcrefl(ip,k)=0.
185        Ncref(ip,k) = 0.
186     endif
187    enddo
188   enddo
189   CALL histwrite3d_cosp(o_Ncrefl,Ncref,nvertp)
190   CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
191
192   do icl=1,Ncolumns
193      CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
194   enddo
195   CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
196 endif !Lidar
197
198 if (cfg%Lradar_sim) then
199   do icl=1,Ncolumns
200      CALL histwrite3d_cosp(o_dbze94,sgradar%Ze_tot(:,icl,:),nvertmcosp,icl)
201   enddo
202   do icl=1,DBZE_BINS
203    CALL histwrite3d_cosp(o_cfadDbze94,stradar%cfad_ze(:,icl,:),nvert,icl)
204   enddo
205 endif
206
207 if (cfg%Llidar_sim .and. cfg%Lradar_sim) then
208   where(stradar%lidar_only_freq_cloud == R_UNDEF) &
209                           stradar%lidar_only_freq_cloud = 0.0
210   CALL histwrite3d_cosp(o_clcalipso2,stradar%lidar_only_freq_cloud,nvert)
211   where(stradar%radar_lidar_tcc == R_UNDEF) &
212                           stradar%radar_lidar_tcc = 0.0
213   CALL histwrite2d_cosp(o_cltlidarradar,stradar%radar_lidar_tcc)
214 endif
215
216 if (cfg%Lisccp_sim) then
217
218! Traitement des valeurs indefinies
219   do ip = 1,Npoints
220    if(isccp%totalcldarea(ip).eq.R_UNDEF)then
221      isccp%totalcldarea(ip)=Cosp_fill_value
222    endif
223    if(isccp%meanptop(ip).eq.R_UNDEF)then
224      isccp%meanptop(ip)=Cosp_fill_value
225    endif
226    if(isccp%meantaucld(ip).eq.R_UNDEF)then
227      isccp%meantaucld(ip)=Cosp_fill_value
228    endif
229    if(isccp%meanalbedocld(ip).eq.R_UNDEF)then
230      isccp%meanalbedocld(ip)=Cosp_fill_value
231    endif
232    if(isccp%meantb(ip).eq.R_UNDEF)then
233      isccp%meantb(ip)=Cosp_fill_value
234    endif
235    if(isccp%meantbclr(ip).eq.R_UNDEF)then
236      isccp%meantbclr(ip)=Cosp_fill_value
237    endif
238
239    do k=1,7
240     do ii=1,7
241     if(isccp%fq_isccp(ip,ii,k).eq.R_UNDEF)then
242      isccp%fq_isccp(ip,ii,k)=Cosp_fill_value
243     endif
244     enddo
245    enddo
246
247    do ii=1,Ncolumns
248     if(isccp%boxtau(ip,ii).eq.R_UNDEF)then
249       isccp%boxtau(ip,ii)=Cosp_fill_value
250     endif
251    enddo
252
253    do ii=1,Ncolumns
254     if(isccp%boxptop(ip,ii).eq.R_UNDEF)then
255       isccp%boxptop(ip,ii)=Cosp_fill_value
256     endif
257    enddo
258   enddo
259
260   CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
261   do icl=1,7
262   CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
263   enddo
264   CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
265   CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
266   CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
267   CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
268   CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
269   CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
270   CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
271   CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
272 endif ! Isccp
273
274! MISR simulator
275 if (cfg%Lmisr_sim) then
276   do ip=1,Npoints
277     do ii=1,7
278       do k=1,MISR_N_CTH
279        if(misr%fq_MISR(ip,ii,k).eq.R_UNDEF)then
280              misr%fq_MISR(ip,ii,k)=Cosp_fill_value
281        endif
282       enddo
283     enddo
284   enddo
285
286   do icl=1,7
287      CALL histwrite3d_cosp(o_clMISR,misr%fq_MISR(:,icl,:),nvertmisr,icl)
288   enddo
289 endif
290
291! Modis simulator
292 if (cfg%Lmodis_sim) then
293
294  do ip=1,Npoints
295    if(modis%Cloud_Fraction_Low_Mean(ip).eq.R_UNDEF)then
296       modis%Cloud_Fraction_Low_Mean(ip)=Cosp_fill_value
297    endif
298    if(modis%Cloud_Fraction_High_Mean(ip).eq.R_UNDEF)then
299       modis%Cloud_Fraction_High_Mean(ip)=Cosp_fill_value
300    endif
301    if(modis%Cloud_Fraction_Mid_Mean(ip).eq.R_UNDEF)then
302       modis%Cloud_Fraction_Mid_Mean(ip)=Cosp_fill_value
303    endif
304    if(modis%Cloud_Fraction_Total_Mean(ip).eq.R_UNDEF)then
305       modis%Cloud_Fraction_Total_Mean(ip)=Cosp_fill_value
306    endif
307    if(modis%Cloud_Fraction_Water_Mean(ip).eq.R_UNDEF)then
308       modis%Cloud_Fraction_Water_Mean(ip)=Cosp_fill_value
309    endif
310    if(modis%Cloud_Fraction_Ice_Mean(ip).eq.R_UNDEF)then
311       modis%Cloud_Fraction_Ice_Mean(ip)=Cosp_fill_value
312    endif
313    if(modis%Optical_Thickness_Total_Mean(ip).eq.R_UNDEF)then
314       modis%Optical_Thickness_Total_Mean(ip)=Cosp_fill_value
315    endif
316    if(modis%Optical_Thickness_Water_Mean(ip).eq.R_UNDEF)then
317       modis%Optical_Thickness_Water_Mean(ip)=Cosp_fill_value
318    endif
319    if(modis%Optical_Thickness_Ice_Mean(ip).eq.R_UNDEF)then
320       modis%Optical_Thickness_Ice_Mean(ip)=Cosp_fill_value
321    endif
322    if(modis%Cloud_Particle_Size_Water_Mean(ip).eq.R_UNDEF)then
323       modis%Cloud_Particle_Size_Water_Mean(ip)=Cosp_fill_value
324    endif
325    if(modis%Cloud_Top_Pressure_Total_Mean(ip).eq.R_UNDEF)then
326       modis%Cloud_Top_Pressure_Total_Mean(ip)=Cosp_fill_value
327    endif
328    if(modis%Liquid_Water_Path_Mean(ip).eq.R_UNDEF)then
329       modis%Liquid_Water_Path_Mean(ip)=Cosp_fill_value
330    endif
331    if(modis%Ice_Water_Path_Mean(ip).eq.R_UNDEF)then
332       modis%Ice_Water_Path_Mean(ip)=Cosp_fill_value
333    endif
334
335  enddo
336   
337   CALL histwrite2d_cosp(o_cllmodis,modis%Cloud_Fraction_Low_Mean)
338   CALL histwrite2d_cosp(o_clhmodis,modis%Cloud_Fraction_High_Mean)
339   CALL histwrite2d_cosp(o_clmmodis,modis%Cloud_Fraction_Mid_Mean)
340   CALL histwrite2d_cosp(o_cltmodis,modis%Cloud_Fraction_Total_Mean)
341   CALL histwrite2d_cosp(o_clwmodis,modis%Cloud_Fraction_Water_Mean)
342   CALL histwrite2d_cosp(o_climodis,modis%Cloud_Fraction_Ice_Mean)
343   CALL histwrite2d_cosp(o_tautmodis,modis%Optical_Thickness_Total_Mean)
344   CALL histwrite2d_cosp(o_tauwmodis,modis%Optical_Thickness_Water_Mean)
345   CALL histwrite2d_cosp(o_tauimodis,modis%Optical_Thickness_Ice_Mean)
346   CALL histwrite2d_cosp(o_tautlogmodis,modis%Optical_Thickness_Total_LogMean) 
347   CALL histwrite2d_cosp(o_tauwlogmodis,modis%Optical_Thickness_Water_LogMean)
348   CALL histwrite2d_cosp(o_tauilogmodis,modis%Optical_Thickness_Ice_LogMean)
349   CALL histwrite2d_cosp(o_reffclwmodis,modis%Cloud_Particle_Size_Water_Mean)
350   CALL histwrite2d_cosp(o_reffclimodis,modis%Cloud_Particle_Size_Ice_Mean)
351   CALL histwrite2d_cosp(o_pctmodis,modis%Cloud_Top_Pressure_Total_Mean)
352   CALL histwrite2d_cosp(o_lwpmodis,modis%Liquid_Water_Path_Mean)
353   CALL histwrite2d_cosp(o_iwpmodis,modis%Ice_Water_Path_Mean)
354
355   do ip=1,Npoints
356     do ii=1,7
357       do k=1,7
358       if(modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k).eq.R_UNDEF)then
359          modis%Optical_Thickness_vs_Cloud_Top_Pressure(ip,ii,k)=0.
360        endif
361       enddo
362     enddo
363    enddo
364
365   do icl=1,7
366   CALL histwrite3d_cosp(o_clmodis, &
367     modis%Optical_Thickness_vs_Cloud_Top_Pressure(:,icl,:),nvertisccp,icl)           
368   enddo
369 endif
370
371 IF(.NOT.cosp_varsdefined) THEN
372!$OMP MASTER
373#ifndef CPP_IOIPSL_NO_OUTPUT
374            DO iff=1,3
375                IF (cosp_outfilekeys(iff)) THEN
376                  CALL histend(cosp_nidfiles(iff))
377                ENDIF ! cosp_outfilekeys
378            ENDDO !  iff
379#endif
380! Fermeture dans phys_output_write
381!#ifdef CPP_XIOS
382            !On finalise l'initialisation:
383            !CALL wxios_closedef()
384!#endif
385
386!$OMP END MASTER
387!$OMP BARRIER
388            cosp_varsdefined = .TRUE.
389 END IF
390
391    IF(cosp_varsdefined) THEN
392! On synchronise les fichiers pour IOIPSL
393#ifndef CPP_IOIPSL_NO_OUTPUT
394!$OMP MASTER
395     DO iff=1,3
396         IF (ok_sync .AND. cosp_outfilekeys(iff)) THEN
397             CALL histsync(cosp_nidfiles(iff))
398         ENDIF
399     END DO
400!$OMP END MASTER
401#endif
402    ENDIF  !cosp_varsdefined
403
404    END SUBROUTINE cosp_output_write
405
406! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod:
407  SUBROUTINE set_itau_iocosp(ito)
408      IMPLICIT NONE
409      INTEGER, INTENT(IN) :: ito
410      itau_iocosp = ito
411  END SUBROUTINE
412
413  SUBROUTINE histdef2d_cosp (iff,var)
414
415    USE ioipsl
416    USE dimphy
417    use iophy
418    USE mod_phys_lmdz_para
419    USE mod_grid_phy_lmdz, ONLY: nbp_lon
420    USE print_control_mod, ONLY: lunout,prt_level
421#ifdef CPP_XIOS
422  USE wxios
423#endif
424
425    IMPLICIT NONE
426
427    INCLUDE "clesphys.h"
428
429    INTEGER                          :: iff
430    TYPE(ctrl_outcosp)               :: var
431
432    REAL zstophym
433    CHARACTER(LEN=20) :: typeecrit
434
435    ! ug On récupère le type écrit de la structure:
436    !       Assez moche, Ã|  refaire si meilleure méthode...
437    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
438       typeecrit = 'once'
439    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
440       typeecrit = 't_min(X)'
441    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
442       typeecrit = 't_max(X)'
443    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
444       typeecrit = 'inst(X)'
445    ELSE
446       typeecrit = cosp_outfiletypes(iff)
447    ENDIF
448
449    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
450       zstophym=zoutm_cosp(iff)
451    ELSE
452       zstophym=zdtimemoy_cosp
453    ENDIF
454
455#ifdef CPP_XIOS
456     IF (.not. ok_all_xml) then
457       IF ( var%cles(iff) ) THEN
458         if (prt_level >= 10) then
459              WRITE(lunout,*)'Appel wxios_add_field_to_file var%name =',var%name
460         endif
461        CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
462                                     var%description, var%unit, 1, typeecrit)
463       ENDIF
464     ENDIF
465#endif
466
467#ifndef CPP_IOIPSL_NO_OUTPUT
468       IF ( var%cles(iff) ) THEN
469          CALL histdef (cosp_nidfiles(iff), var%name, var%description, var%unit, &
470               nbp_lon,jj_nb,nhoricosp(iff), 1,1,1, -99, 32, &
471               typeecrit, zstophym,zoutm_cosp(iff))
472       ENDIF
473#endif
474
475  END SUBROUTINE histdef2d_cosp
476
477 SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
478    USE ioipsl
479    USE dimphy
480    use iophy
481    USE mod_phys_lmdz_para
482    USE mod_grid_phy_lmdz, ONLY: nbp_lon
483    USE print_control_mod, ONLY: lunout,prt_level
484
485#ifdef CPP_XIOS
486  USE wxios
487#endif
488
489
490    IMPLICIT NONE
491
492    INCLUDE "clesphys.h"
493
494    INTEGER                        :: iff, klevs
495    INTEGER, INTENT(IN), OPTIONAL  :: ncols ! ug RUSTINE POUR LES variables 4D
496    INTEGER, INTENT(IN)           :: nvertsave
497    TYPE(ctrl_outcosp)             :: var
498
499    REAL zstophym
500    CHARACTER(LEN=20) :: typeecrit, nomi
501    CHARACTER(LEN=20) :: nom
502    character(len=2) :: str2
503    CHARACTER(len=20) :: nam_axvert
504
505! Axe vertical
506      IF (nvertsave.eq.nvertp(iff)) THEN
507          klevs=PARASOL_NREFL
508          nam_axvert="sza"
509      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
510          klevs=7
511          nam_axvert="pressure2"
512      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
513          klevs=Ncolout
514          nam_axvert="column"
515      ELSE IF (nvertsave.eq.nverttemp(iff)) THEN
516          klevs=LIDAR_NTEMP
517          nam_axvert="temp"
518      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
519          klevs=MISR_N_CTH
520           nam_axvert="cth16"
521      ELSE
522           klevs=Nlevout
523           nam_axvert="presnivs"
524      ENDIF
525
526! ug RUSTINE POUR LES Champs 4D
527      IF (PRESENT(ncols)) THEN
528               write(str2,'(i2.2)')ncols
529               nomi=var%name
530               nom="c"//str2//"_"//nomi
531      ELSE
532               nom=var%name
533      END IF
534
535    ! ug On récupère le type écrit de la structure:
536    !       Assez moche, Ã|  refaire si meilleure méthode...
537    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
538       typeecrit = 'once'
539    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
540       typeecrit = 't_min(X)'
541    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
542       typeecrit = 't_max(X)'
543    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
544       typeecrit = 'inst(X)'
545    ELSE
546       typeecrit = cosp_outfiletypes(iff)
547    ENDIF
548
549    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
550       zstophym=zoutm_cosp(iff)
551    ELSE
552       zstophym=zdtimemoy_cosp
553    ENDIF
554
555#ifdef CPP_XIOS
556      IF (.not. ok_all_xml) then
557        IF ( var%cles(iff) ) THEN
558          if (prt_level >= 10) then
559              WRITE(lunout,*)'Appel wxios_add_field_to_file 3d nom variable nam_axvert = ',nom, nam_axvert
560          endif
561          CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
562                                       var%description, var%unit, 1, typeecrit, nam_axvert)
563        ENDIF
564      ENDIF
565#endif
566
567#ifndef CPP_IOIPSL_NO_OUTPUT
568       IF ( var%cles(iff) ) THEN
569          CALL histdef (cosp_nidfiles(iff), nom, var%description, var%unit, &
570               nbp_lon, jj_nb, nhoricosp(iff), klevs, 1, &
571               klevs, nvertsave, 32, typeecrit, &
572               zstophym, zoutm_cosp(iff))
573       ENDIF
574#endif
575
576  END SUBROUTINE histdef3d_cosp
577
578 SUBROUTINE histwrite2d_cosp(var,field)
579  USE dimphy
580  USE mod_phys_lmdz_para
581  USE ioipsl
582  use iophy
583  USE mod_grid_phy_lmdz, ONLY: nbp_lon
584  USE print_control_mod, ONLY: lunout,prt_level
585
586#ifdef CPP_XIOS
587  USE xios, only: xios_send_field
588#endif
589
590  IMPLICIT NONE
591  INCLUDE 'clesphys.h'
592
593    TYPE(ctrl_outcosp), INTENT(IN) :: var
594    REAL, DIMENSION(:), INTENT(IN) :: field
595
596    INTEGER :: iff
597
598    REAL,DIMENSION(klon_mpi) :: buffer_omp
599    INTEGER, allocatable, DIMENSION(:) :: index2d
600    REAL :: Field2d(nbp_lon,jj_nb)
601    CHARACTER(LEN=20) ::  nomi, nom
602    character(len=2) :: str2
603    LOGICAL, SAVE  :: firstx
604!$OMP THREADPRIVATE(firstx)
605
606    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
607
608  ! On regarde si on est dans la phase de définition ou d'écriture:
609  IF(.NOT.cosp_varsdefined) THEN
610!$OMP MASTER
611      !Si phase de définition.... on définit
612      CALL conf_cospoutputs(var%name,var%cles)
613      DO iff=1, 3
614         IF (cosp_outfilekeys(iff)) THEN
615            CALL histdef2d_cosp(iff, var)
616         ENDIF
617      ENDDO
618!$OMP END MASTER
619  ELSE
620    !Et sinon on.... écrit
621    IF (SIZE(field)/=klon) &
622  CALL abort_physic('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
623
624    CALL Gather_omp(field,buffer_omp)
625!$OMP MASTER
626    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
627
628! La boucle sur les fichiers:
629      firstx=.true.
630      DO iff=1, 3
631           IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
632                ALLOCATE(index2d(nbp_lon*jj_nb))
633#ifndef CPP_IOIPSL_NO_OUTPUT
634        CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,nbp_lon*jj_nb,index2d)
635#endif
636                deallocate(index2d)
637#ifdef CPP_XIOS
638              IF (.not. ok_all_xml) then
639                 if (firstx) then
640                  if (prt_level >= 10) then
641                    WRITE(lunout,*)'xios_send_field variable ',var%name
642                  endif
643                  CALL xios_send_field(var%name, Field2d)
644                   firstx=.false.
645                 endif
646              ENDIF
647#endif
648           ENDIF
649      ENDDO
650
651#ifdef CPP_XIOS
652      IF (ok_all_xml) THEN
653        if (prt_level >= 1) then
654              WRITE(lunout,*)'xios_send_field variable ',var%name
655        endif
656       CALL xios_send_field(var%name, Field2d)
657      ENDIF
658#endif
659
660!$OMP END MASTER   
661  ENDIF ! vars_defined
662  IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',var%name
663  END SUBROUTINE histwrite2d_cosp
664
665! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
666! AI sept 2013
667  SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
668  USE dimphy
669  USE mod_phys_lmdz_para
670  USE ioipsl
671  use iophy
672  USE mod_grid_phy_lmdz, ONLY: nbp_lon
673  USE print_control_mod, ONLY: lunout,prt_level
674
675#ifdef CPP_XIOS
676  USE xios, only: xios_send_field
677#endif
678
679
680  IMPLICIT NONE
681  INCLUDE 'clesphys.h'
682
683    TYPE(ctrl_outcosp), INTENT(IN)    :: var
684    REAL, DIMENSION(:,:), INTENT(IN)  :: field ! --> field(klon,:)
685    INTEGER, INTENT(IN), OPTIONAL     :: ncols ! ug RUSTINE POUR LES Champs 4D.....
686    INTEGER, DIMENSION(3), INTENT(IN) :: nverts
687
688    INTEGER :: iff, k
689
690    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
691    REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
692    INTEGER :: ip, n, nlev
693    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
694    CHARACTER(LEN=20) ::  nomi, nom
695    character(len=2) :: str2
696    LOGICAL, SAVE  :: firstx
697!$OMP THREADPRIVATE(firstx)
698
699  IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
700
701! ug RUSTINE POUR LES STD LEVS.....
702      IF (PRESENT(ncols)) THEN
703              write(str2,'(i2.2)')ncols
704              nomi=var%name
705              nom="c"//str2//"_"//nomi
706      ELSE
707               nom=var%name
708      END IF
709  ! On regarde si on est dans la phase de définition ou d'écriture:
710  IF(.NOT.cosp_varsdefined) THEN
711      !Si phase de définition.... on définit
712!$OMP MASTER
713      CALL conf_cospoutputs(var%name,var%cles)
714      DO iff=1, 3
715        IF (cosp_outfilekeys(iff)) THEN
716          CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
717        ENDIF
718      ENDDO
719!$OMP END MASTER
720  ELSE
721    !Et sinon on.... écrit
722    IF (SIZE(field,1)/=klon) &
723   CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
724    nlev=SIZE(field,2)
725
726
727    CALL Gather_omp(field,buffer_omp)
728!$OMP MASTER
729    CALL grid1Dto2D_mpi(buffer_omp,field3d)
730
731! BOUCLE SUR LES FICHIERS
732     firstx=.true.
733     DO iff=1, 3
734        IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
735           ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
736#ifndef CPP_IOIPSL_NO_OUTPUT
737    CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,nbp_lon*jj_nb*nlev,index3d)
738#endif
739
740#ifdef CPP_XIOS
741          IF (.not. ok_all_xml) then
742           IF (firstx) THEN
743               CALL xios_send_field(nom, Field3d(:,:,1:nlev))
744               IF (prt_level >= 9) WRITE(lunout,*)'xios_send_field ',var%name
745               firstx=.FALSE.
746           ENDIF
747          ENDIF
748#endif
749         deallocate(index3d)
750        ENDIF
751      ENDDO
752#ifdef CPP_XIOS
753    IF (ok_all_xml) THEN
754     CALL xios_send_field(nom, Field3d(:,:,1:nlev))
755     IF (prt_level >= 1) WRITE(lunout,*)'xios_send_field ',var%name
756    ENDIF
757#endif
758
759!$OMP END MASTER   
760  ENDIF ! vars_defined
761  IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
762  END SUBROUTINE histwrite3d_cosp
763
764  SUBROUTINE conf_cospoutputs(nam_var,cles_var)
765!!! Lecture des noms et cles de sortie des variables dans config.def
766    !   en utilisant les routines getin de IOIPSL 
767    use ioipsl
768    USE print_control_mod, ONLY: lunout,prt_level
769
770    IMPLICIT NONE
771
772   CHARACTER(LEN=20)               :: nam_var, nnam_var
773   LOGICAL, DIMENSION(3)           :: cles_var
774
775! Lecture dans config.def ou output.def de cles_var et name_var
776    CALL getin('cles_'//nam_var,cles_var)
777    CALL getin('name_'//nam_var,nam_var)
778    IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
779
780  END SUBROUTINE conf_cospoutputs
781
782 END MODULE cosp_output_write_mod
Note: See TracBrowser for help on using the repository browser.