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

Last change on this file since 1992 was 1986, checked in by jghattas, 11 years ago

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