source: LMDZ5/trunk/libf/cosp/cosp_output_write_mod.F90 @ 2118

Last change on this file since 2118 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: 15.1 KB
RevLine 
[1926]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)
[2080]10   INTEGER, save        :: Nlevout, Ncolout
11!$OMP THREADPRIVATE(Nlevout, Ncolout)
[1926]12
13!  INTERFACE histwrite_cosp
14!    MODULE PROCEDURE histwrite2d_cosp,histwrite3d_cosp
15!  END INTERFACE
16
17   CONTAINS
18
[2080]19  SUBROUTINE cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, cfg, gbx, vgrid, sglidar, stlidar, isccp)
[1926]20
21    USE ioipsl
22    USE control_mod
23
24#ifdef CPP_XIOS
25    ! ug Pour les sorties XIOS
[1986]26    USE wxios
[1926]27#endif
28
29!!! Variables d'entree
30  integer               :: itap, Nlevlmdz, Ncolumns, Npoints
31  real                  :: freq_COSP, dtime
32  type(cosp_config)     :: cfg     ! Control outputs
33  type(cosp_gridbox)    :: gbx     ! Gridbox information. Input for COSP
34  type(cosp_sglidar)    :: sglidar ! Output from lidar simulator
35  type(cosp_isccp)      :: isccp   ! Output from ISCCP simulator
36  type(cosp_lidarstats) :: stlidar ! Summary statistics from lidar simulator
[2080]37  type(cosp_vgrid)      :: vgrid   ! Information on vertical grid of stats
[1926]38
39!!! Variables locales
40  integer               :: icl, iinitend=1
41  logical               :: ok_sync
42  integer               :: itau_wcosp
43  real, dimension(Npoints,PARASOL_NREFL) :: parasolcrefl, Ncref
44
45  include "temps.h"
46
[2080]47  Nlevout = vgrid%Nlvgrid
48  Ncolout = Ncolumns
49
[1926]50  IF (MOD(itap,NINT(freq_COSP/dtime)).EQ.0) THEN
51       
52! A refaire
53       itau_wcosp = itau_phy + itap + start_time * day_step / iphysiq
54
55! On le donne a  cosp_output_write_mod pour que les histwrite y aient acces:
56       CALL set_itau_iocosp(itau_wcosp)
57
58    ok_sync = .TRUE.
59   
60    IF(.NOT.cosp_varsdefined) THEN
61        iinitend = 2
62    ELSE
63        iinitend = 1
64    ENDIF
65
66! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
67DO iinit=1, iinitend
68#ifdef CPP_XIOS
69IF (cosp_varsdefined) THEN
70     CALL wxios_update_calendar(itau_iocosp)
71END IF
72#endif
73
74 if (cfg%Llidar_sim) then
[2080]75! print*,'cfg%Llidar_sim dans output_write',cfg%Llidar_sim
76! print*,'Nlevout Npoints dans output_write, R_UNDEF =',Nlevout,Npoints,R_UNDEF
[1926]77! Pb des valeurs indefinies, on les met a 0
78! A refaire proprement
79  do k = 1,Nlevout
80     do ip = 1,Npoints
81     if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
82      stlidar%lidarcld(ip,k)=0.
83     endif
84     enddo
85
86     do ii= 1,SR_BINS
87      do ip = 1,Npoints
88       if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
89        stlidar%cfad_sr(ip,ii,k)=0.
90       endif
91      enddo
92     enddo
93   enddo
94
95  do ip = 1,Npoints
96   do k = 1,Nlevlmdz
97     if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
98      sglidar%beta_mol(ip,k)=0.
99     endif
100
101     do ii= 1,Ncolumns
102       if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
103        sglidar%beta_tot(ip,ii,k)=0.
104       endif
105     enddo
106
107    enddo    !k = 1,Nlevlmdz
108   enddo     !ip = 1,Npoints
109
110   do k = 1,LIDAR_NCAT
111    do ip = 1,Npoints
112     if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
113      stlidar%cldlayer(ip,k)=0.
114     endif
115    enddo
116   enddo
117
118   CALL histwrite2d_cosp(o_cllcalipso,stlidar%cldlayer(:,1))
119   CALL histwrite2d_cosp(o_clhcalipso,stlidar%cldlayer(:,3))
120   CALL histwrite2d_cosp(o_clmcalipso,stlidar%cldlayer(:,2))
121   CALL histwrite2d_cosp(o_cltcalipso,stlidar%cldlayer(:,4))
122   CALL histwrite3d_cosp(o_clcalipso,stlidar%lidarcld,nvert)
123
124   do icl=1,SR_BINS
125      CALL histwrite3d_cosp(o_cfad_lidarsr532,stlidar%cfad_sr(:,icl,:),nvert,icl)
126   enddo
127
128   CALL histwrite3d_cosp(o_parasol_refl,stlidar%parasolrefl,nvertp)
129
130   do k=1,PARASOL_NREFL
131    do ip=1, Npoints
132     if (stlidar%cldlayer(ip,4).gt.0.01) then
133       parasolcrefl(ip,k)=(stlidar%parasolrefl(ip,k)-0.03*(1.-stlidar%cldlayer(ip,4)))/ &
134                            stlidar%cldlayer(ip,4)
135        Ncref(ip,k) = 1.
136     else
137        parasolcrefl(ip,k)=0.
138        Ncref(ip,k) = 0.
139     endif
140    enddo
141   enddo
142   CALL histwrite3d_cosp(o_parasol_crefl,parasolcrefl,nvertp)
143
144   do icl=1,Ncolumns
145      CALL histwrite3d_cosp(o_atb532,sglidar%beta_tot(:,icl,:),nvertmcosp,icl)
146   enddo
147   CALL histwrite3d_cosp(o_beta_mol532,sglidar%beta_mol,nvertmcosp)
148 endif !Lidar
149
150 if (cfg%Lisccp_sim) then
151
152! Traitement des valeurs indefinies
153   do ip = 1,Npoints
154    if(isccp%totalcldarea(ip).eq.-1.E+30)then
155      isccp%totalcldarea(ip)=0.
156    endif
157    if(isccp%meanptop(ip).eq.-1.E+30)then
158      isccp%meanptop(ip)=0.
159    endif
160    if(isccp%meantaucld(ip).eq.-1.E+30)then
161      isccp%meantaucld(ip)=0.
162    endif
163    if(isccp%meanalbedocld(ip).eq.-1.E+30)then
164      isccp%meanalbedocld(ip)=0.
165    endif
166    if(isccp%meantb(ip).eq.-1.E+30)then
167      isccp%meantb(ip)=0.
168    endif
169    if(isccp%meantbclr(ip).eq.-1.E+30)then
170      isccp%meantbclr(ip)=0.
171    endif
172
173    do k=1,7
174     do ii=1,7
175     if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
176      isccp%fq_isccp(ip,ii,k)=0.
177     endif
178     enddo
179    enddo
180
181    do ii=1,Ncolumns
182     if(isccp%boxtau(ip,ii).eq.-1.E+30)then
183       isccp%boxtau(ip,ii)=0.
184     endif
185    enddo
186
187    do ii=1,Ncolumns
188     if(isccp%boxptop(ip,ii).eq.-1.E+30)then
189       isccp%boxptop(ip,ii)=0.
190     endif
191    enddo
192   enddo
193
194   CALL histwrite2d_cosp(o_sunlit,gbx%sunlit)
195   do icl=1,7
196   CALL histwrite3d_cosp(o_clisccp2,isccp%fq_isccp(:,icl,:),nvertisccp,icl)
197   enddo
198   CALL histwrite3d_cosp(o_boxtauisccp,isccp%boxtau,nvertcol)
199   CALL histwrite3d_cosp(o_boxptopisccp,isccp%boxptop,nvertcol)
200   CALL histwrite2d_cosp(o_tclisccp,isccp%totalcldarea)
201   CALL histwrite2d_cosp(o_ctpisccp,isccp%meanptop)
202   CALL histwrite2d_cosp(o_tauisccp,isccp%meantaucld)
203   CALL histwrite2d_cosp(o_albisccp,isccp%meanalbedocld)
204   CALL histwrite2d_cosp(o_meantbisccp,isccp%meantb)
205   CALL histwrite2d_cosp(o_meantbclrisccp,isccp%meantbclr)
206 endif ! Isccp
207
208 IF(.NOT.cosp_varsdefined) THEN
209!$OMP MASTER
210            DO iff=1,3
211                IF (cosp_outfilekeys(iff)) THEN
212                  CALL histend(cosp_nidfiles(iff))
213                ENDIF ! cosp_outfilekeys
214            ENDDO !  iff
215#ifdef CPP_XIOS
216            !On finalise l'initialisation:
217            CALL wxios_closedef()
218#endif
219!$OMP END MASTER
220!$OMP BARRIER
221            cosp_varsdefined = .TRUE.
222 END IF
223END DO  !! iinit
224
225!    IF(cosp_varsdefined) THEN
226! On synchronise les fichiers pour IOIPSL
227!$OMP MASTER
228   DO iff=1,3
229         IF (ok_sync .AND. cosp_outfilekeys(iff)) THEN
230             CALL histsync(cosp_nidfiles(iff))
231         ENDIF
232   END DO
233!$OMP END MASTER
234
235   ENDIF ! if freq_COSP
236
237    END SUBROUTINE cosp_output_write
238
239! ug Routine pour definir itau_iocosp depuis cosp_output_write_mod:
240  SUBROUTINE set_itau_iocosp(ito)
241      IMPLICIT NONE
242      INTEGER, INTENT(IN) :: ito
243      itau_iocosp = ito
244  END SUBROUTINE
245
246  SUBROUTINE histdef2d_cosp (iff,var)
247
248    USE ioipsl
249    USE dimphy
250    use iophy
251    USE mod_phys_lmdz_para
[1986]252#ifdef CPP_XIOS
253  USE wxios
254#endif
[1926]255
256    IMPLICIT NONE
257
258    INCLUDE "dimensions.h"
259    INCLUDE "temps.h"
260
261    INTEGER                          :: iff
262    TYPE(ctrl_outcosp)               :: var
263
264    REAL zstophym
265    CHARACTER(LEN=20) :: typeecrit
266
267    ! ug On récupère le type écrit de la structure:
268    !       Assez moche, Ã|  refaire si meilleure méthode...
269    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
270       typeecrit = 'once'
271    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
272       typeecrit = 't_min(X)'
273    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
274       typeecrit = 't_max(X)'
275    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
276       typeecrit = 'inst(X)'
277    ELSE
278       typeecrit = cosp_outfiletypes(iff)
279    ENDIF
280
281    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
282       zstophym=zoutm_cosp(iff)
283    ELSE
284       zstophym=zdtimemoy_cosp
285    ENDIF
286
287#ifdef CPP_XIOS
[1986]288        CALL wxios_add_field_to_file(var%name, 2, cosp_nidfiles(iff), cosp_outfilenames(iff), &
289        var%description, var%unit, 1, typeecrit)
[1926]290#endif
291       IF ( var%cles(iff) ) THEN
292          CALL histdef (cosp_nidfiles(iff), var%name, var%description, var%unit, &
293               iim,jj_nb,nhoricosp(iff), 1,1,1, -99, 32, &
294               typeecrit, zstophym,zoutm_cosp(iff))
295       ENDIF
296
297  END SUBROUTINE histdef2d_cosp
298
299 SUBROUTINE histdef3d_cosp (iff,var,nvertsave,ncols)
300    USE ioipsl
301    USE dimphy
302    use iophy
303    USE mod_phys_lmdz_para
304
[1986]305#ifdef CPP_XIOS
306  USE wxios
307#endif
308
309
[1926]310    IMPLICIT NONE
311
312    INCLUDE "dimensions.h"
313    INCLUDE "temps.h"
314
315    INTEGER                        :: iff, klevs
316    INTEGER, INTENT(IN), OPTIONAL  :: ncols ! ug RUSTINE POUR LES variables 4D
317    INTEGER, INTENT(IN)           :: nvertsave
318    TYPE(ctrl_outcosp)             :: var
319
320    REAL zstophym
321    CHARACTER(LEN=20) :: typeecrit, nomi
322    CHARACTER(LEN=20) :: nom
323    character(len=2) :: str2
324
325! Axe vertical
326      IF (nvertsave.eq.nvertp(iff)) THEN
327          klevs=PARASOL_NREFL
328      ELSE IF (nvertsave.eq.nvertisccp(iff)) THEN
329          klevs=7
330      ELSE IF (nvertsave.eq.nvertcol(iff)) THEN
331          klevs=Ncolout
332      ELSE
333          klevs=Nlevout
334      ENDIF
335     
336         
337! ug RUSTINE POUR LES Champs 4D
338      IF (PRESENT(ncols)) THEN
339               write(str2,'(i2.2)')ncols
340               nomi=var%name
341               nom="c"//str2//"_"//nomi
342      ELSE
343               nom=var%name
344      END IF
345
346    ! ug On récupère le type écrit de la structure:
347    !       Assez moche, Ã|  refaire si meilleure méthode...
348    IF (INDEX(var%cosp_typeecrit(iff), "once") > 0) THEN
349       typeecrit = 'once'
350    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_min") > 0) THEN
351       typeecrit = 't_min(X)'
352    ELSE IF(INDEX(var%cosp_typeecrit(iff), "t_max") > 0) THEN
353       typeecrit = 't_max(X)'
354    ELSE IF(INDEX(var%cosp_typeecrit(iff), "inst") > 0) THEN
355       typeecrit = 'inst(X)'
356    ELSE
357       typeecrit = cosp_outfiletypes(iff)
358    ENDIF
359
360    IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
361       zstophym=zoutm_cosp(iff)
362    ELSE
363       zstophym=zdtimemoy_cosp
364    ENDIF
365
366#ifdef CPP_XIOS
[1986]367        CALL wxios_add_field_to_file(nom, 3, cosp_nidfiles(iff), cosp_outfilenames(iff), &
368        var%description, var%unit, 1, typeecrit)
[1926]369#endif
370       IF ( var%cles(iff) ) THEN
371          CALL histdef (cosp_nidfiles(iff), nom, var%description, var%unit, &
372               iim, jj_nb, nhoricosp(iff), klevs, 1, &
373               klevs, nvertsave, 32, typeecrit, &
374               zstophym, zoutm_cosp(iff))
375       ENDIF
376  END SUBROUTINE histdef3d_cosp
377
378 SUBROUTINE histwrite2d_cosp(var,field)
379  USE dimphy
380  USE mod_phys_lmdz_para
381  USE ioipsl
382  use iophy
383
384#ifdef CPP_XIOS
385  USE wxios
386#endif
387
388  IMPLICIT NONE
389  INCLUDE 'dimensions.h'
390  INCLUDE 'iniprint.h'
391
392    TYPE(ctrl_outcosp), INTENT(IN) :: var
393    REAL, DIMENSION(:), INTENT(IN) :: field
394
395    INTEGER :: iff
396
397    REAL,DIMENSION(klon_mpi) :: buffer_omp
398    INTEGER, allocatable, DIMENSION(:) :: index2d
399    REAL :: Field2d(iim,jj_nb)
400    CHARACTER(LEN=20) ::  nomi, nom
401    character(len=2) :: str2
402
403    IF (prt_level >= 9) WRITE(lunout,*)'Begin histrwrite2d ',var%name
404
405  ! On regarde si on est dans la phase de définition ou d'écriture:
406  IF(.NOT.cosp_varsdefined) THEN
407!$OMP MASTER
408      !Si phase de définition.... on définit
409      CALL conf_cospoutputs(var%name,var%cles)
410      DO iff=1, 3
411         IF (cosp_outfilekeys(iff)) THEN
412            CALL histdef2d_cosp(iff, var)
413         ENDIF
414      ENDDO
415!$OMP END MASTER
416  ELSE
417    !Et sinon on.... écrit
418    IF (SIZE(field)/=klon) &
419  CALL abort_gcm('iophy::histwrite2d_cosp','Field first DIMENSION not equal to klon',1)
420
421    CALL Gather_omp(field,buffer_omp)
422!$OMP MASTER
423    CALL grid1Dto2D_mpi(buffer_omp,Field2d)
424
425! La boucle sur les fichiers:
426      DO iff=1, 3
427           IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
428                ALLOCATE(index2d(iim*jj_nb))
429        CALL histwrite(cosp_nidfiles(iff),var%name,itau_iocosp,Field2d,iim*jj_nb,index2d)
430#ifdef CPP_XIOS
431                IF (iff == 1) THEN
432                   CALL wxios_write_2D(var%name, Field2d)
433                ENDIF
434#endif
435
436                deallocate(index2d)
437           ENDIF !levfiles
438      ENDDO
439!$OMP END MASTER   
440  ENDIF ! vars_defined
441  IF (prt_level >= 9) WRITE(lunout,*)'End histrwrite2d_cosp ',nom
442  END SUBROUTINE histwrite2d_cosp
443
444! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
445! AI sept 2013
446  SUBROUTINE histwrite3d_cosp(var, field, nverts, ncols)
447  USE dimphy
448  USE mod_phys_lmdz_para
449  USE ioipsl
450  use iophy
451
452#ifdef CPP_XIOS
[1986]453 USE WXIOS
[1926]454#endif
455
456
457  IMPLICIT NONE
458  INCLUDE 'dimensions.h'
459  INCLUDE 'iniprint.h'
460
461    TYPE(ctrl_outcosp), INTENT(IN)    :: var
462    REAL, DIMENSION(:,:), INTENT(IN)  :: field ! --> field(klon,:)
463    INTEGER, INTENT(IN), OPTIONAL     :: ncols ! ug RUSTINE POUR LES Champs 4D.....
464    INTEGER, DIMENSION(3), INTENT(IN) :: nverts
465
466    INTEGER :: iff, k
467
468    REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
469    REAL :: Field3d(iim,jj_nb,SIZE(field,2))
470    INTEGER :: ip, n, nlev
471    INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
472    CHARACTER(LEN=20) ::  nomi, nom
473    character(len=2) :: str2
474
475  IF (prt_level >= 9) write(lunout,*)'Begin histrwrite3d ',var%name
476
477! ug RUSTINE POUR LES STD LEVS.....
478      IF (PRESENT(ncols)) THEN
479              write(str2,'(i2.2)')ncols
480              nomi=var%name
481              nom="c"//str2//"_"//nomi
482      ELSE
483               nom=var%name
484      END IF
485  ! On regarde si on est dans la phase de définition ou d'écriture:
486  IF(.NOT.cosp_varsdefined) THEN
487      !Si phase de définition.... on définit
488!$OMP MASTER
489      CALL conf_cospoutputs(var%name,var%cles)
490      DO iff=1, 3
491        IF (cosp_outfilekeys(iff)) THEN
492          CALL histdef3d_cosp(iff, var, nverts(iff), ncols)
493        ENDIF
494      ENDDO
495!$OMP END MASTER
496  ELSE
497    !Et sinon on.... écrit
498    IF (SIZE(field,1)/=klon) &
499   CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)                                 
500    nlev=SIZE(field,2)
501
502
503    CALL Gather_omp(field,buffer_omp)
504!$OMP MASTER
505    CALL grid1Dto2D_mpi(buffer_omp,field3d)
506
507
508! BOUCLE SUR LES FICHIERS
509     DO iff=1, 3
510        IF (var%cles(iff) .AND. cosp_outfilekeys(iff)) THEN
511           ALLOCATE(index3d(iim*jj_nb*nlev))
512    CALL histwrite(cosp_nidfiles(iff),nom,itau_iocosp,Field3d,iim*jj_nb*nlev,index3d)
513
514#ifdef CPP_XIOS
515           IF (iff == 1) THEN
516               CALL wxios_write_3D(nom, Field3d(:,:,1:klev))
517           ENDIF
518#endif
519         deallocate(index3d)
520        ENDIF
521      ENDDO
522!$OMP END MASTER   
523  ENDIF ! vars_defined
524  IF (prt_level >= 9) write(lunout,*)'End histrwrite3d_cosp ',nom
525  END SUBROUTINE histwrite3d_cosp
526
527  SUBROUTINE conf_cospoutputs(nam_var,cles_var)
528!!! Lecture des noms et cles de sortie des variables dans config.def
529    !   en utilisant les routines getin de IOIPSL 
530    use ioipsl
531
532    IMPLICIT NONE
533    include 'iniprint.h'
534
535   CHARACTER(LEN=20)               :: nam_var, nnam_var
536   LOGICAL, DIMENSION(3)           :: cles_var
537
538! Lecture dans config.def ou output.def de cles_var et name_var
539    CALL getin('cles_'//nam_var,cles_var)
540    CALL getin('name_'//nam_var,nam_var)
541    IF(prt_level>10) WRITE(lunout,*)'nam_var cles_var ',nam_var,cles_var(:)
542
543  END SUBROUTINE conf_cospoutputs
544
545 END MODULE cosp_output_write_mod
Note: See TracBrowser for help on using the repository browser.