Changeset 1999 for LMDZ5/branches/testing/libf/cosp/phys_cosp.F90

Timestamp:

Mar 20, 2014, 10:57:19 AM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r1920:1997 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/cosp/phys_cosp.F90 (modified) (14 diffs)

LMDZ5/branches/testing/libf/cosp/phys_cosp.F90

@@ -7 +7 @@
                         ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
                         ecrit_mth,ecrit_day,ecrit_hf, &
-                        Nptslmdz,Nlevlmdz,lon,lat, presnivs,overlaplmdz, &
+                        Nptslmdz,Nlevlmdz,lon,lat, presnivs,overlaplmdz,sunlit, &
                         ref_liq,ref_ice,fracTerLic,u_wind,v_wind,phis,phi,ph,p,skt,t, &
                         sh,rh,tca,cca,mr_lsliq,mr_lsice,fl_lsrainI,fl_lssnowI, &
@@ -22 +22 @@
 ! lon,lat,                              !Longitudes et latitudes de la grille LMDZ
 ! ref_liq,ref_ice,                      !Rayons effectifs des particules liq et ice (en microm)
-! fracTerLic,                               !Fraction terre a convertir en masque
+! fracTerLic,                           !Fraction terre a convertir en masque
 ! u_wind,v_wind,                        !Vents a 10m ???
 ! phi,                                  !Geopotentiel
-! phis,                                  !Geopotentiel sol
+! phis,                                 !Geopotentiel sol
 ! ph,                                   !pression pour chaque inter-couche
 ! p,                                    !Pression aux milieux des couches
@@ -76 +76 @@
   use ioipsl
   use iophy
+  use cosp_output_mod
+  use cosp_output_write_mod
  
   IMPLICIT NONE
@@ -86 +88 @@
   integer, save :: isccp_topheight,isccp_topheight_direction,overlap
   integer,save  :: Ncolumns     ! Number of subcolumns in SCOPS
-!  integer,parameter :: Ncollmdz=20
-  integer,parameter :: Ncolmax=100
   integer, save :: Npoints      ! Number of gridpoints
 !$OMP THREADPRIVATE(Npoints)
@@ -119 +119 @@
 
 ! Declaration necessaires pour les sorties IOIPSL
-  integer :: ii,idayref
-  real    :: zjulian,zstoday,zstomth,zstohf,zout,ecrit_day,ecrit_hf,ecrit_mth
+  integer :: ii
+  real    :: ecrit_day,ecrit_hf,ecrit_mth
   logical :: ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
-  integer :: nhori,nvert,nvertp,nvertisccp,nvertmcosp,nvertcol
-  integer, save :: nid_day_cosp,nid_mth_cosp,nid_hf_cosp
-!$OMP THREADPRIVATE(nid_day_cosp,nid_mth_cosp,nid_hf_cosp)
+
   logical, save :: debut_cosp=.true.
 !$OMP THREADPRIVATE(debut_cosp)
-  integer :: itau_wcosp
-  character(len=2) :: str2
-  real,dimension(Ncolmax) :: column_ax
-  character(len=10),save,dimension(Ncolmax) :: chcol
-
-  integer, save :: Nlevout
-!$OMP THREADPRIVATE(Nlevout)
 
   include "dimensions.h"
-  include "temps.h"  
   
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Input variables from LMDZ-GCM
@@ -144 +134 @@
                                      zlev,zlev_half,mr_ozone,radliq,radice,dtau_s,dem_s,ref_liq,ref_ice
   real,dimension(Nptslmdz,Nlevlmdz) ::  fl_lsrainI,fl_lssnowI,fl_ccrainI,fl_ccsnowI
-  real,dimension(Nptslmdz)        :: lon,lat,skt,fracTerLic,u_wind,v_wind,phis
+  real,dimension(Nptslmdz)        :: lon,lat,skt,fracTerLic,u_wind,v_wind,phis,sunlit         
   real,dimension(Nlevlmdz)        :: presnivs
   integer                         :: itap,k,ip
   real                            :: dtime,freq_cosp
-  logical, parameter              :: lCOSP=.FALSE.
-
+  
 !
    namelist/COSP_INPUT/cmor_nl,overlap,isccp_topheight,isccp_topheight_direction, &
@@ -173 +162 @@
   CALL read_cosp_input
 
-  do ii=1,Ncolumns
-    write(str2,'(i2.2)')ii
-    chcol(ii)="c"//str2
-    column_ax(ii) = real(ii)
-  enddo
-
 ! Clefs Outputs 
   call read_cosp_output_nl(cosp_output_nl,cfg)
@@ -187 +170 @@
    print*,'Fin lecture Namelists, debut_cosp =',debut_cosp
 
-  print*,' Cles sorties cosp :'
+  print*,' Cles des differents simulateurs cosp :'
   print*,' Lradar_sim,Llidar_sim,Lisccp_sim,Lmisr_sim,Lrttov_sim', &
           cfg%Lradar_sim,cfg%Llidar_sim,cfg%Lisccp_sim,cfg%Lmisr_sim,cfg%Lrttov_sim
@@ -193 +176 @@
   endif ! debut_cosp
 
-  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
-          itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-! Allocate local arrays
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-!        call system_clock(t0,count_rate,count_max) !!! Only for testing purposes
-        
-        
+!  print*,'Debut phys_cosp itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf ', &
+!          itap,dtime,freq_cosp,ecrit_mth,ecrit_day,ecrit_hf
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 ! Allocate memory for gridbox type
@@ -237 +214 @@
         gbx%q = rh*100.
         gbx%sh = sh
-        gbx%cca = cca !convective_cloud_amount (1)
+! On ne veut pas que cosp distingue les nuages stratiformes et convectifs
+! on passe les contenus totaux (conv+strat)
+        gbx%cca = 0. !convective_cloud_amount (1)
         gbx%tca = tca ! total_cloud_amount (1)
         gbx%psfc = ph(:,1) !pression de surface
@@ -253 +232 @@
         gbx%u_wind  = u_wind !eastward_wind (m s-1)
         gbx%v_wind  = v_wind !northward_wind
-! Attention
-        gbx%sunlit  = 1
+
+! sunlit calcule a partir de la fraction d ensoleillement par jour
+      do ip = 1, Npoints
+        if (sunlit(ip).le.0.) then
+           gbx%sunlit(ip)=0.
+        else
+           gbx%sunlit(ip)=1.
+        endif
+      enddo
 
 ! A voir l equivalent LMDZ
@@ -296 +282 @@
         call construct_cosp_vgrid(gbx,Nlr,use_vgrid,csat_vgrid,vgrid)
 
- if (debut_cosp) then
-! Creer le fichier de sorie, definir les variable de sortie
-  ! Axe verticale (Pa ou Km)
-     Nlevout = vgrid%Nlvgrid
-   
-        do ii=1,Ncolumns
-          column_ax(ii) = real(ii)
-        enddo
-
- if (ok_mensuelCOSP) then
-     include "ini_histmthCOSP.h"
- endif
- if (ok_journeCOSP) then
-     include "ini_histdayCOSP.h"
- endif
- if (ok_hfCOSP) then
-     include "ini_histhfCOSP.h"
- endif
-
-   debut_cosp=.false.
-  endif ! debut_cosp
-
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ! Allocate memory for other types
@@ -329 +293 @@
         call construct_cosp_isccp(cfg,Npoints,Ncolumns,Nlevels,isccp)
         call construct_cosp_misr(cfg,Npoints,misr)
+
+!+++++++++++++ Open output files and define output files axis !+++++++++++++
+     if (debut_cosp) then
+
+        print *, ' Open outpts files and define axis'
+        call cosp_output_open(Nlevlmdz, Ncolumns, presnivs, dtime, freq_cosp, &
+                              ok_mensuelCOSP, ok_journeCOSP, ok_hfCOSP, &
+                              ecrit_mth, ecrit_day, ecrit_hf, use_vgrid, vgrid)
+
+        debut_cosp=.false.
+      endif ! debut_cosp
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
         ! Call simulator
@@ -335 +310 @@
         call cosp(overlap,Ncolumns,cfg,vgrid,gbx,sgx,sgradar,sglidar,isccp,misr,stradar,stlidar)
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-        ! Write outputs to CMOR-compliant NetCDF
-!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-
-! A traiter le cas ou l on a des valeurs indefinies
-! Attention teste
-
-! if(1.eq.0)then
-
-
-   do k = 1,Nlevout
-     do ip = 1,Npoints
-     if(stlidar%lidarcld(ip,k).eq.R_UNDEF)then
-      stlidar%lidarcld(ip,k)=0.
-     endif
-     enddo
-
-
-     do ii= 1,SR_BINS
-      do ip = 1,Npoints
-       if(stlidar%cfad_sr(ip,ii,k).eq.R_UNDEF)then
-        stlidar%cfad_sr(ip,ii,k)=0.
-       endif
-      enddo
-     enddo
-   enddo   
-   
-  do ip = 1,Npoints
-   do k = 1,Nlevlmdz 
-     if(sglidar%beta_mol(ip,k).eq.R_UNDEF)then
-      sglidar%beta_mol(ip,k)=0.
-     endif
-    
-     do ii= 1,Ncolumns
-       if(sglidar%beta_tot(ip,ii,k).eq.R_UNDEF)then
-        sglidar%beta_tot(ip,ii,k)=0.
-       endif  
-     enddo
-
-    enddo    !k = 1,Nlevlmdz
-   enddo     !ip = 1,Npoints
-
-   do k = 1,LIDAR_NCAT
-    do ip = 1,Npoints
-     if(stlidar%cldlayer(ip,k).eq.R_UNDEF)then
-      stlidar%cldlayer(ip,k)=0.
-     endif
-    enddo
-   enddo
-
-! endif 
-
-   do ip = 1,Npoints
-    if(isccp%totalcldarea(ip).eq.-1.E+30)then
-      isccp%totalcldarea(ip)=0.
-    endif
-    if(isccp%meanptop(ip).eq.-1.E+30)then
-      isccp%meanptop(ip)=0.
-    endif
-    if(isccp%meantaucld(ip).eq.-1.E+30)then
-      isccp%meantaucld(ip)=0.
-    endif
-    if(isccp%meanalbedocld(ip).eq.-1.E+30)then
-      isccp%meanalbedocld(ip)=0.
-    endif
-    if(isccp%meantb(ip).eq.-1.E+30)then
-      isccp%meantb(ip)=0.
-    endif
-    if(isccp%meantbclr(ip).eq.-1.E+30)then
-      isccp%meantbclr(ip)=0.
-    endif
-
-    do k=1,7
-     do ii=1,7
-     if(isccp%fq_isccp(ip,ii,k).eq.-1.E+30)then
-      isccp%fq_isccp(ip,ii,k)=0.
-     endif
-     enddo
-    enddo
-
-    do ii=1,Ncolumns
-     if(isccp%boxtau(ip,ii).eq.-1.E+30)then
-       isccp%boxtau(ip,ii)=0.
-     endif
-    enddo
-
-    do ii=1,Ncolumns
-     if(isccp%boxptop(ip,ii).eq.-1.E+30)then
-       isccp%boxptop(ip,ii)=0.
-     endif
-    enddo
-   enddo
-
- if (ok_mensuelCOSP) then
-  include "write_histmthCOSP.h"
- endif
- if (ok_journeCOSP) then
-  include "write_histdayCOSP.h"
- endif
- if (ok_hfCOSP ) then
-  include "write_histhfCOSP.h"
- endif
+
+!!!!!!!!!!!!!!!!!! Ecreture des sorties Cosp !!!!!!!!!!!!!!r!!!!!!:!!!!!
+       print *, 'Calling write output'
+        call cosp_output_write(Nlevlmdz, Npoints, Ncolumns, itap, dtime, freq_COSP, cfg, gbx, sglidar, stlidar, isccp)
 
 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++