Changeset 3506 for trunk/LMDZ.PLUTO/libf

Timestamp:

Nov 8, 2024, 10:57:27 AM (6 weeks ago)

Author:

afalco

Message:

Pluto: import write_output function from Mars.
xios specific outputs.
AF

Location:

trunk/LMDZ.PLUTO/libf/phypluto

Files:

• phyetat0_mod.F90 (modified) (2 diffs)
• physiq_mod.F90 (modified) (4 diffs)
• write_output_mod.F90 (added)
• writediagsoil.F90 (modified) (14 diffs)
• xios_output_mod.F90 (modified) (11 diffs)

trunk/LMDZ.PLUTO/libf/phypluto/phyetat0_mod.F90

@@ -2 +2 @@
 
 implicit none
+
+real, save :: tab_cntrl_mod(100)
+
+!$OMP THREADPRIVATE(tab_cntrl_mod)
+
 
 contains
@@ -282 +287 @@
 end subroutine phyetat0
 
+
+!======================================================================
+subroutine ini_tab_controle_dyn_xios(idayref)
+
+use comcstfi_mod,        only: g, mugaz, omeg, rad, rcp
+use time_phylmdz_mod,  only: daysec, dtphys
+use mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, nbp_lev
+
+implicit none
+
+integer*4, intent(in) :: idayref ! date (initial date for this run)
+
+integer :: length, l
+parameter (length = 100)
+real    :: tab_cntrl(length) ! run parameters are stored in this array
+
+do l = 1,length
+    tab_cntrl(l) = 0.
+enddo
+tab_cntrl(1)  = real(nbp_lon)
+tab_cntrl(2)  = real(nbp_lat-1)
+tab_cntrl(3)  = real(nbp_lev)
+tab_cntrl(4)  = real(idayref)
+tab_cntrl(5)  = rad
+tab_cntrl(6)  = omeg
+tab_cntrl(7)  = g
+tab_cntrl(8)  = mugaz
+tab_cntrl(9)  = rcp
+tab_cntrl(10) = daysec
+tab_cntrl(11) = dtphys
+
+tab_cntrl_mod = tab_cntrl
+
+end subroutine ini_tab_controle_dyn_xios
+
+
 end module phyetat0_mod

trunk/LMDZ.PLUTO/libf/phypluto/physiq_mod.F90

@@ -37 +37 @@
                           nesp, is_chim, is_condensable,constants_epsi_generic
       use time_phylmdz_mod, only: ecritphy, iphysiq, nday
-      use phyetat0_mod, only: phyetat0
+      use phyetat0_mod, only: phyetat0,tab_cntrl_mod
       use wstats_mod, only: callstats, wstats, mkstats
       use phyredem, only: physdem0, physdem1
@@ -79 +79 @@
       use datafile_mod, only: datadir
 #ifndef MESOSCALE
-      use vertical_layers_mod, only: presnivs, pseudoalt
+      USE vertical_layers_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt
       use mod_phys_lmdz_omp_data, ONLY: is_omp_master
 #else
@@ -745 +745 @@
 #ifdef CPP_XIOS
 
-         write(*,*) "physiq: call initialize_xios_output"
-         call initialize_xios_output(pday,ptime,ptimestep,daysec, &
-                                     year_day,presnivs,pseudoalt,WNOI,WNOV)
+         if (is_master) write(*,*) "physiq: call initialize_xios_output"
+         call initialize_xios_output(pday,ptime,ptimestep,daysec,year_day, &
+                                     presnivs,pseudoalt,mlayer,WNOI,WNOV)
 #endif
 
@@ -2637 +2637 @@
       ! Send fields to XIOS: (NB these fields must also be defined as
       ! <field id="..." /> in context_lmdz_physics.xml to be correctly used)
-      CALL send_xios_field("ls",zls)
-
-      CALL send_xios_field("ps",ps)
-      CALL send_xios_field("area",cell_area)
-      CALL send_xios_field("p",pplay)
-      CALL send_xios_field("temperature",zt)
-      CALL send_xios_field("u",zu)
-      CALL send_xios_field("v",zv)
-      call send_xios_field("w",pw)
-
-      CALL send_xios_field("ISR",fluxtop_dn)
-      CALL send_xios_field("OLR",fluxtop_lw)
-      CALL send_xios_field("ASR",fluxabs_sw)
-
-      if (specOLR .and. corrk) then
-         call send_xios_field("OLR3D",OLR_nu)
-         call send_xios_field("IR_Bandwidth",DWNI)
-         call send_xios_field("VI_Bandwidth",DWNV)
-         call send_xios_field("OSR3D",OSR_nu)
-         call send_xios_field("GSR3D",GSR_nu)
-      endif
+      CALL send_xios_field("controle",tab_cntrl_mod,1)
+
+      CALL send_xios_field("ap",ap,1)
+      CALL send_xios_field("bp",bp,1)
+      CALL send_xios_field("aps",aps,1)
+      CALL send_xios_field("bps",bps,1)
 
       if (lastcall.and.is_omp_master) then

trunk/LMDZ.PLUTO/libf/phypluto/writediagsoil.F90

@@ +1 @@
+module writediagsoil_mod
+
+implicit none
+
+contains
+
 subroutine writediagsoil(ngrid,name,title,units,dimpx,px)
 
@@ -86 +92 @@
     stop
   endif
-  
+
   ! Set output sample rate
   isample=int(ecritphy) ! same as for diagfi outputs
   ! Note ecritphy is known from control.h
-  
+
   ! Create output NetCDF file
   if (is_master) then
@@ -129 +135 @@
     enddo
    endif
-   
+
    ! write "header" of file (longitudes, latitudes, geopotential, ...)
    if (klon_glo>1) then ! general 3D case
@@ -138 +144 @@
 
   endif ! of if (is_master)
-  
+
   ! set zitau to -1 to be compatible with zitau incrementation step below
   zitau=-1
-  
+
 else
   ! If not an initialization call, simply open the NetCDF file
@@ -164 +170 @@
     date=float(zitau+1)/float(day_step)
     ! Note: day_step is known from control.h
-    
+
     if (is_master) then
      ! Get NetCDF ID for "time"
@@ -176 +182 @@
      if (ierr.ne.NF_NOERR) then
       write(*,*)"writediagsoil: Failed writing date to time variable"
-      stop 
+      stop
      endif
     endif ! of if (is_master)
@@ -217 +223 @@
   endif
 #endif
-  
+
   ! B. Write (append) the variable to the NetCDF file
   if (is_master) then
@@ -235 +241 @@
     call def_var(nid,name,title,units,4,id,varid,ierr)
   endif ! of if (ierr.ne.NF_NOERR)
-  
+
   ! B.2. Prepare things to be able to write/append the variable
   corners(1)=1
@@ -241 +247 @@
   corners(3)=1
   corners(4)=ntime
-  
+
   if (klon_glo==1) then
     edges(1)=1
@@ -250 +256 @@
   edges(3)=nsoilmx
   edges(4)=1
-  
+
   ! B.3. Write the slab of data
 !#ifdef NC_DOUBLE
@@ -324 +330 @@
   corners(2)=1
   corners(3)=ntime
-  
+
   if (klon_glo==1) then
     edges(1)=1
@@ -332 +338 @@
   edges(2)=nbp_lat
   edges(3)=1
-  
+
   ! B.3. Write the slab of data
 !#ifdef NC_DOUBLE
@@ -373 +379 @@
   ! B.2. Prepare things to be able to write/append the variable
   corners(1)=ntime
-  
+
   edges(1)=1
 
@@ -396 +402 @@
 
 end subroutine writediagsoil
+
+end module writediagsoil_mod

trunk/LMDZ.PLUTO/libf/phypluto/xios_output_mod.F90

@@ -11 +11 @@
 
  INTERFACE send_xios_field
-    MODULE PROCEDURE histwrite0d_xios,histwrite2d_xios,histwrite3d_xios!,histwrite1d_xios
+    MODULE PROCEDURE histwrite0d_xios,histwrite1d_xios,histwrite2d_xios,histwrite3d_xios
  END INTERFACE
 
@@ -17 +17 @@
 CONTAINS
 
-  SUBROUTINE initialize_xios_output(day,timeofday,dtphys,daysec,&
-                                    yearday,presnivs,pseudoalt,wnoi,wnov)
-!  USE mod_phys_lmdz_para, only: gather, bcast, &
-!                                jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
-!                                mpi_size, mpi_rank, klon_mpi, &
-!                                is_sequential, is_south_pole_dyn
+  SUBROUTINE initialize_xios_output(day,timeofday,dtphys,daysec,yearday,   &
+                                    presnivs,pseudoalt,mlayer,wnoi,wnov)
   USE mod_phys_lmdz_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
                                 mpi_size, mpi_rank, klon_mpi, &
@@ -44 +40 @@
   REAL,INTENT(IN) :: presnivs(:) ! vertical grid approximate pressure (Pa)
   REAL,INTENT(IN) :: pseudoalt(:) ! vertical grid approximate altitude (km)
+  REAL,INTENT(IN) :: mlayer(:) ! soil layer depth at intermediate level (m)
   REAL,INTENT(IN) :: wnoi(:) ! Array of wavenumbers at the spectral interval centers for the infrared.
   real,intent(in) :: wnov (:) !Array of wavenumbers at the spectral interval centers for the visible.
+
 
   INTEGER :: data_ibegin, data_iend
@@ -62 +60 @@
     CALL xios_set_axis_attr("altitude", n_glo=size(pseudoalt), value=pseudoalt,&
                             unit="km",positive="up")
+    CALL xios_set_axis_attr("interlayer", n_glo=size(pseudoalt)+1,&
+                            unit="km",positive="up")
+    IF (prt_level>=10) WRITE(lunout,*) "initialize_xios_output: call xios_set_axis_attr for soil"
+    CALL xios_set_axis_attr("soil_layers", n_glo=size(mlayer), value=mlayer,&
+                            unit="m",positive="down")
     if (prt_level >=10) write(lunout,*) "initialize_xios_output: call xios_set_axis_attr for IR_Wavenumber"
     write(lunout,*) "writing IR_Wavenumber now in initialize_xios_output"
@@ -139 +142 @@
     ! Now define the start time of this simulation
     ! NB: we substract dtphys because we want to set the origin of the time axis
-    start_date=time_origin+xios_duration(0,0,day,0,0,timeofday*daysec-dtphys)
+    start_date=time_origin
     call xios_set_start_date(start_date=start_date)
     if (prt_level>=10) then
@@ -148 +151 @@
     if (prt_level>=10) write(*,*) "initialize_xios_output: call wxios_closedef"
     CALL wxios_closedef()
+    if (prt_level>=10) write(*,*) "initialize_xios_output: after call wxios_closedef"
 
 !$OMP END MASTER
@@ -211 +215 @@
 
   END SUBROUTINE histwrite0d_xios
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE histwrite1d_xios(field_name,field,dimens)
+  USE xios, ONLY: xios_send_field
+  USE print_control_mod, ONLY: prt_level, lunout
+  IMPLICIT NONE
+
+    CHARACTER(LEN=*), INTENT(IN) :: field_name
+    REAL, DIMENSION(:), INTENT(IN) :: field
+    INTEGER, INTENT(IN) :: dimens
+    IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite1d_xios ',trim(field_name)
+!$OMP MASTER
+    CALL xios_send_field(field_name,field)
+!$OMP END MASTER
+
+    IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite1d_xios ',trim(field_name)
+
+  END SUBROUTINE histwrite1d_xios
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -221 +244 @@
   USE print_control_mod, ONLY: prt_level, lunout
   USE mod_grid_phy_lmdz, ONLY: nbp_lon
-  USE radinc_h ,only: L_NSPECTI,L_NSPECTV
   IMPLICIT NONE
 
@@ -230 +252 @@
     REAL :: Field2d(nbp_lon,jj_nb)
 
+    CHARACTER(len=128) :: msg
+
     IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',trim(field_name)
-    if ((size(field) .eq. L_NSPECTI) .or. (size(field) .eq. L_NSPECTV)) then
-!$OMP MASTER
-      ! only for spectral stuff: IR_Bandwidth and VI_Bandwidth
-      call xios_send_field(field_name,field)
-!$OMP END MASTER
-      return
-    endif
-    IF (SIZE(field)/=klon) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon',1)
-
+    IF (SIZE(field)/=klon) THEN
+      WRITE(msg,*) "Pb with field "//trim(field_name)//&
+                   " : Field first DIMENSION not equal to klon"
+      CALL abort_physic('iophy::histwrite2d_xios',trim(msg),1)
+    ENDIF
     CALL Gather_omp(field,buffer_omp)
 !$OMP MASTER
@@ -269 +289 @@
     INTEGER :: ip, n, nlev
 
+    CHARACTER(len=128) :: msg
+
   IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',trim(field_name)
 
-    !Et on.... écrit
-    IF (SIZE(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
+    !And we write...
+    IF (SIZE(field,1)/=klon) THEN
+      WRITE(msg,*) "Pb with field "//trim(field_name)//&
+                   " : Field first DIMENSION not equal to klon"
+      CALL abort_physic('iophy::histwrite3d',trim(msg),1)
+    ENDIF
+
     nlev=SIZE(field,2)
 
@@ -286 +313 @@
   END SUBROUTINE histwrite3d_xios
 
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+ FUNCTION xios_is_active_field(field_id)
+ USE xios, only: xios_field_is_active
+ USE mod_phys_lmdz_omp_transfert, only: bcast_omp
+ IMPLICIT NONE
+   LOGICAL ::  xios_is_active_field
+   CHARACTER(LEN=*) :: field_id
+
+ ! check with XIOS if "field_id" is requested by the user
+ ! to be in the output file(s)
+
+!$OMP BARRIER
+!$OMP MASTER
+   xios_is_active_field = xios_field_is_active(field_id)
+!$OMP END MASTER
+   CALL bcast_omp(xios_is_active_field)
+ END FUNCTION xios_is_active_field
+
 #endif