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

! A.Idelkadi sept 2013 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!! Module pour declarer et initialiser les parametres de controle des fichiers de sorties et des champs a sortir
!! La routine cosp_output_open (appelee 1 seule fois dans phy_cosp.F90) permet :
!! de creer les fichiers avec leurs grilles horizontales et verticales
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  MODULE cosp_output_mod

  USE MOD_COSP_CONSTANTS
  USE MOD_COSP_TYPES

! cosp_output_mod
      INTEGER, PRIVATE             :: i
!!!!!!! Controle des fichier de sorties Cosp !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      LOGICAL, DIMENSION(3), SAVE  :: cosp_outfilekeys
      INTEGER, DIMENSION(3), SAVE  :: cosp_nidfiles
!$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles)
      INTEGER, DIMENSION(3), SAVE  :: nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp
      REAL, DIMENSION(3), SAVE                :: zoutm_cosp
!$OMP THREADPRIVATE(nhoricosp, nvert, nvertmcosp, nvertcol, nvertisccp, nvertp, zoutm_cosp)
      REAL, SAVE                   :: zdtimemoy_cosp
!$OMP THREADPRIVATE(zdtimemoy_cosp) 
      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfiletypes
      CHARACTER(LEN=20), DIMENSION(3), SAVE  :: cosp_outfilenames
      REAL, DIMENSION(3), SAVE               :: cosp_ecritfiles 
!$OMP THREADPRIVATE(cosp_outfiletypes, cosp_outfilenames, cosp_ecritfiles)

!!!!  Controle des variables a sortir dans les fichiers !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  TYPE ctrl_outcosp
     LOGICAL,DIMENSION(3)                 :: cles             !!! Sortir ou non le champs
     CHARACTER(len=20)                    :: name       
     CHARACTER(len=150)                   :: description      !!! Nom
     CHARACTER(len=20)                    :: unit             !!! Unite 
     CHARACTER(len=20),DIMENSION(3)  :: cosp_typeecrit        !!! Operation (ave, inst, ...)
  END TYPE ctrl_outcosp
! CALIPSO vars
  TYPE(ctrl_outcosp), SAVE :: o_cllcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "cllcalipso", "Lidar Low-level Cloud Fraction", "1", (/ ('', i=1, 3) /))                                   
  TYPE(ctrl_outcosp), SAVE :: o_clmcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "clmcalipso", "Lidar Mid-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_clhcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "clhcalipso", "Lidar Hight-level Cloud Fraction", "1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_cltcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "cltcalipso", "Lidar Total Cloud Fraction", "1", (/ ('', i=1, 3) /)) 
  TYPE(ctrl_outcosp), SAVE :: o_clcalipso = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "clcalipso", "Lidar Cloud Fraction (532 nm)", "1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_cfad_lidarsr532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
         "cfad_lidarsr532", "Lidar Scattering Ratio CFAD (532 nm)", "1", (/ ('', i=1, 3) /))   
  TYPE(ctrl_outcosp), SAVE :: o_parasol_refl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "parasol_refl", "PARASOL-like mono-directional reflectance","1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_parasol_crefl = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &              
         "parasol_crefl", "PARASOL-like mono-directional reflectance (integral)","1", (/ ('', i=1, 3) /))                  
  TYPE(ctrl_outcosp), SAVE :: o_atb532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
         "atb532", "Lidar Attenuated Total Backscatter (532 nm)","1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_beta_mol532 = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
         "beta_mol532", "Lidar Molecular Backscatter (532 nm)","m-1 sr-1", (/ ('', i=1, 3) /))
! ISCCP vars
  TYPE(ctrl_outcosp), SAVE :: o_sunlit = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "sunlit", "1 for day points, 0 for nightime","1",(/ ('', i=1, 3) /))                   
  TYPE(ctrl_outcosp), SAVE :: o_clisccp2 = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
         "clisccp2", "Cloud Fraction as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_boxtauisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
         "boxtauisccp", "Optical Depth in Each Column as Calculated by the ISCCP Simulator","1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_boxptopisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
         "boxptopisccp", "Cloud Top Pressure in Each Column as Calculated by the ISCCP Simulator","Pa", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_tclisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "tclisccp", "Total Cloud Fraction as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /)) 
  TYPE(ctrl_outcosp), SAVE :: o_ctpisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "ctpisccp", "Mean Cloud Top Pressure as Calculated by the ISCCP Simulator", "Pa", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_tauisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "tauisccp", "Optical Depth as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_albisccp = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
          "albisccp", "Mean Cloud Albedo as Calculated by the ISCCP Simulator", "1", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_meantbisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
          "meantbisccp", " Mean all-sky 10.5 micron brightness temperature as calculated &
           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))
  TYPE(ctrl_outcosp), SAVE :: o_meantbclrisccp = ctrl_outcosp((/ .FALSE., .FALSE., .FALSE. /), &
          "meantbclrisccp", "Mean clear-sky 10.5 micron brightness temperature as calculated &
           by the ISCCP Simulator","K", (/ ('', i=1, 3) /))

   LOGICAL, SAVE :: cosp_varsdefined = .FALSE. ! ug PAS THREADPRIVATE ET C'EST NORMAL

CONTAINS

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!! Ouverture des fichier et definition des  axes!!!!!!!!
  !! histbeg, histvert
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 

  SUBROUTINE cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, ok_all_xml,  &
                              ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)


  USE iophy
  USE ioipsl
  USE phys_cal_mod

#ifdef CPP_XIOS
    ! ug Pour les sorties XIOS
    USE wxios
#endif

  IMPLICIT NONE

!!! Variables d'entree
  integer                  :: Nlevlmdz, Ncolumns      ! Number of levels
  real,dimension(Nlevlmdz) :: presnivs
  real                     :: dtime, freq_cosp, ecrit_day, ecrit_hf, ecrit_mth 
  logical                  :: ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, use_vgrid, ok_all_xml                    
  type(cosp_vgrid)   :: vgrid   ! Information on vertical grid of stats

!!! Variables locales
  integer                  :: idayref, iff, ii
  real                     :: zjulian,zjulian_start
  real,dimension(Ncolumns) :: column_ax
  CHARACTER(LEN=20), DIMENSION(3)  :: chfreq = (/ '1day', '1d', '3h' /)            

!!! Variables d'entree
  include "temps.h"
  INCLUDE 'iniprint.h'

#ifdef CPP_XIOS
    ! ug Variables utilisées pour récupérer le calendrier pour xios
    INTEGER :: x_an, x_mois, x_jour
    REAL :: x_heure
    INTEGER :: ini_an, ini_mois, ini_jour
    REAL :: ini_heure
#endif

    WRITE(lunout,*) 'Debut cosp_output_mod.F90'
    print*,'cosp_varsdefined',cosp_varsdefined
    ! Initialisations (Valeurs par defaut)

    do ii=1,Ncolumns
      column_ax(ii) = real(ii)
    enddo


    cosp_outfilenames(1) = 'histmthCOSP'
    cosp_outfilenames(2) = 'histdayCOSP'
    cosp_outfilenames(3) = 'histhfCOSP'

    cosp_outfiletypes(1) = 'ave(X)'
    cosp_outfiletypes(2) = 'ave(X)'
    cosp_outfiletypes(3) = 'ave(X)'

    cosp_outfilekeys(1) = ok_mensuelCOSP
    cosp_outfilekeys(2) = ok_journeCOSP
    cosp_outfilekeys(3) = ok_hfCOSP

    cosp_ecritfiles(1) = mth_len*86400.
    cosp_ecritfiles(2) = 1.*86400.
    cosp_ecritfiles(3) = 0.125*86400.

! Lecture des parametres dans output.def ou config.def

    CALL getin('cosp_outfilenames',cosp_outfilenames)
    CALL getin('cosp_outfilekeys',cosp_outfilekeys)
    CALL getin('cosp_ecritfiles',cosp_ecritfiles)
    CALL getin('cosp_outfiletypes',cosp_outfiletypes)

    WRITE(lunout,*)'cosp_outfilenames=',cosp_outfilenames
    WRITE(lunout,*)'cosp_outfilekeys=',cosp_outfilekeys
    WRITE(lunout,*)'cosp_ecritfiles=',cosp_ecritfiles
    WRITE(lunout,*)'cosp_outfiletypes=',cosp_outfiletypes
    
    idayref = day_ref
    CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
    CALL ymds2ju(annee_ref, 1, day_ini, start_time, zjulian_start)

#ifdef CPP_XIOS
    ! ug R\'eglage du calendrier xios
    !Temps julian => an, mois, jour, heure
    CALL ju2ymds(zjulian, x_an, x_mois, x_jour, x_heure)
    CALL ju2ymds(zjulian_start, ini_an, ini_mois, ini_jour, ini_heure)
    CALL wxios_set_cal(dtime, calend, x_an, x_mois, x_jour, x_heure, ini_an, &
                       ini_mois, ini_jour, ini_heure )
       ! ug d�claration des axes verticaux de chaque fichier:
    if (use_vgrid) then
        CALL wxios_add_vaxis("height", vgrid%Nlvgrid, vgrid%z)
    else
         WRITE(lunout,*) 'wxios_add_vaxis "presnivs", vgrid%Nlvgrid ',vgrid%Nlvgrid
        CALL wxios_add_vaxis("presnivs", vgrid%Nlvgrid, presnivs)
    endif
    WRITE(lunout,*) 'wxios_add_vaxis height_mlev, Nlevlmdz ',Nlevlmdz
    CALL wxios_add_vaxis("height_mlev", Nlevlmdz, vgrid%mz)
    WRITE(lunout,*) 'wxios_add_vaxis sza, PARASOL_NREFL ',PARASOL_NREFL
    CALL wxios_add_vaxis("sza", PARASOL_NREFL, PARASOL_SZA)
    WRITE(lunout,*) 'wxios_add_vaxis pressure2 ',7
    CALL wxios_add_vaxis("pressure2", 7, ISCCP_PC)
    WRITE(lunout,*) 'wxios_add_vaxis column ',Ncolumns
    CALL wxios_add_vaxis("column", Ncolumns, column_ax)
#endif
   
    zdtimemoy_cosp = freq_COSP         ! Frequence ou l on moyenne

    DO iff=1,3
       zoutm_cosp(iff) = cosp_ecritfiles(iff) ! Frequence ou l on ecrit en seconde

       IF (cosp_outfilekeys(iff)) THEN
           CALL histbeg_phy_all(cosp_outfilenames(iff),itau_phy,zjulian,&
             dtime,nhoricosp(iff),cosp_nidfiles(iff))
           print*,'histbeg_phy nhoricosp(iff),cosp_nidfiles(iff)', &
                    nhoricosp(iff),cosp_nidfiles(iff)

#ifdef CPP_XIOS
        IF (.not. ok_all_xml) then
         WRITE(lunout,*) 'wxios_add_file ',cosp_outfilenames(iff)
         CALL wxios_add_file(cosp_outfilenames(iff),chfreq(iff),10)
        ENDIF
#endif

#ifndef CPP_IOIPSL_NO_OUTPUT 
! Definition de l'axe vertical
       if (use_vgrid) then
! Axe vertical Cosp 40 niveaux (en m)
      CALL histvert(cosp_nidfiles(iff),"height","height","m",vgrid%Nlvgrid,vgrid%z,nvert(iff))
       else
! Axe vertical modele LMDZ presnivs
      CALL histvert(cosp_nidfiles(iff),"presnivs","Vertical levels","Pa",vgrid%Nlvgrid,presnivs,nvert(iff),"down")
       endif
! Axe vertical niveaux modele (en m)
      CALL histvert(cosp_nidfiles(iff),"height_mlev","height_mlev","m",Nlevlmdz,vgrid%mz,nvertmcosp(iff))

      CALL histvert(cosp_nidfiles(iff),"sza","solar_zenith_angle","degrees",PARASOL_NREFL,PARASOL_SZA,nvertp(iff))

      CALL histvert(cosp_nidfiles(iff),"pressure2","pressure","mb",7,ISCCP_PC,nvertisccp(iff),"down")

      CALL histvert(cosp_nidfiles(iff),"column","column","count",Ncolumns,column_ax(1:Ncolumns),nvertcol(iff))
#endif

      ENDIF
  ENDDO

    end SUBROUTINE cosp_output_open

 END MODULE cosp_output_mod