Changeset 3506 for trunk/LMDZ.PLUTO/libf/phypluto/xios_output_mod.F90

Timestamp:

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

Author:

afalco

Message:

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

File:

• trunk/LMDZ.PLUTO/libf/phypluto/xios_output_mod.F90 (modified) (11 diffs)

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