Changeset 2056 for LMDZ5/branches/testing/libf/phylmd/iophy.F90

Timestamp:

Jun 11, 2014, 3:46:46 PM (10 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r1997:2055 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/iophy.F90 (modified) (19 diffs)

LMDZ5/branches/testing/libf/phylmd/iophy.F90

@@ -568 +568 @@
     INCLUDE "temps.h"
     INCLUDE "clesphys.h"
+    INCLUDE "iniprint.h"
 
     INTEGER                          :: iff
@@ -602 +603 @@
 
 #ifdef CPP_XIOS
+      IF ( var%flag(iff)<=lev_files(iff) ) THEN
         CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), &
         var%description, var%unit, var%flag(iff), typeecrit)
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', &
+                          trim(var%name),iff
+        ENDIF
+      ENDIF
 #endif
 #ifndef CPP_NO_IOIPSL 
@@ -628 +635 @@
     END IF
   END SUBROUTINE histdef2d
+
   SUBROUTINE histdef3d (iff,var)
 
@@ -645 +653 @@
     INCLUDE "temps.h"
     INCLUDE "clesphys.h"
+    INCLUDE "iniprint.h"
 
     INTEGER                          :: iff
@@ -679 +688 @@
 
 #ifdef CPP_XIOS
+      IF ( var%flag(iff)<=lev_files(iff) ) THEN
         CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), &
         var%description, var%unit, var%flag(iff), typeecrit)
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', &
+                          trim(var%name),iff
+        ENDIF
+      ENDIF
 #endif
 #ifndef CPP_NO_IOIPSL 
@@ -868 +883 @@
                                  nid_files
 #ifdef CPP_XIOS
-  USE wxios, only: wxios_write_2D
+  USE xios, only: xios_send_field
 #endif
 
@@ -881 +896 @@
       
     INTEGER :: iff, iff_beg, iff_end
-      
+    LOGICAL, SAVE  :: firstx
+!$OMP THREADPRIVATE(firstx)
+
     REAL,DIMENSION(klon_mpi) :: buffer_omp
     INTEGER, allocatable, DIMENSION(:) :: index2d
@@ -889 +906 @@
     REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
 
-    IF (prt_level >= 10) WRITE(lunout,*)'Begin histwrite2d_phy ',trim(var%name)
-
+    IF (prt_level >= 10) THEN
+      WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
+    ENDIF
 ! ug RUSTINE POUR LES STD LEVS.....
       IF (PRESENT(STD_iff)) THEN
@@ -925 +943 @@
 
 ! La boucle sur les fichiers:
+      firstx=.true.
       DO iff=iff_beg, iff_end
             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN 
-    
+
+#ifdef CPP_XIOS
+               IF (firstx) THEN
+                  if (prt_level >= 10) then
+                     write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',&
+                                    iff,trim(var%name)                       
+                     write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field"
+                  endif
+                  CALL xios_send_field(var%name, Field2d)
+                  firstx=.false.
+               ENDIF
+#endif
+
                   IF(.NOT.clef_stations(iff)) THEN
                         ALLOCATE(index2d(iim*jj_nb))
@@ -934 +965 @@
                         CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,iim*jj_nb,index2d)
 #endif
-#ifdef CPP_XIOS
-                        IF (iff == iff_beg) THEN
-                          if (prt_level >= 10) then
-                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
-                          endif
-                          CALL wxios_write_2D(var%name, Field2d)
-                        ENDIF
-#endif
+!#ifdef CPP_XIOS
+!                        IF (iff == iff_beg) THEN
+!                          if (prt_level >= 10) then
+!                            write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
+!                          endif
+!                          CALL xios_send_field(var%name, Field2d)
+!                        ENDIF
+!#endif
                   ELSE 
                         ALLOCATE(fieldok(npstn))
@@ -988 +1019 @@
                                  nid_files
 #ifdef CPP_XIOS
-  USE wxios, only: wxios_write_3D
+  USE xios, only: xios_send_field
 #endif
 
@@ -1001 +1032 @@
       
     INTEGER :: iff, iff_beg, iff_end
-
+    LOGICAL, SAVE  :: firstx
+!$OMP THREADPRIVATE(firstx)
     REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
     REAL :: Field3d(iim,jj_nb,SIZE(field,2))
-    INTEGER :: ip, n, nlev
+    INTEGER :: ip, n, nlev, nlevx
     INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
     REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
@@ -1033 +1065 @@
     IF (SIZE(field,1)/=klon) CALL abort_gcm('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
     nlev=SIZE(field,2)
-
+    if (nlev.eq.klev+1) then
+        nlevx=klev
+    else
+        nlevx=nlev
+    endif
 
     CALL Gather_omp(field,buffer_omp)
@@ -1041 +1077 @@
 
 ! BOUCLE SUR LES FICHIERS
+     firstx=.true.
      DO iff=iff_beg, iff_end
             IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
+#ifdef CPP_XIOS
+              IF (firstx) THEN
+                if (prt_level >= 10) then
+                  write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', &
+                                  iff,nlev,klev, firstx                       
+                  write(lunout,*)'histwrite3d_phy: call xios_send_field for ', &
+                                  trim(var%name), ' with iim jjm nlevx = ', &
+                                  iim,jj_nb,nlevx
+                endif
+                CALL xios_send_field(var%name, Field3d(:,:,1:nlevx))
+                            firstx=.false.
+              ENDIF
+#endif
                 IF (.NOT.clef_stations(iff)) THEN
                         ALLOCATE(index3d(iim*jj_nb*nlev))
@@ -1051 +1101 @@
 #endif
 
-#ifdef CPP_XIOS
-                        IF (iff == 1) THEN
-                              CALL wxios_write_3D(var%name, Field3d(:,:,1:klev))
-                        ENDIF
-#endif
-                        
+!#ifdef CPP_XIOS
+!                        IF (iff == 1) THEN
+!                              CALL xios_send_field(var%name, Field3d(:,:,1:klev))
+!                        ENDIF
+!#endif
+!                        
                 ELSE 
                         nlev=size(field,2)
@@ -1099 +1149 @@
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
-  USE wxios, only: wxios_write_2D
+  USE xios, only: xios_send_field
 
 
@@ -1134 +1184 @@
 
 
-        CALL wxios_write_2D(field_name, Field2d)
+        CALL xios_send_field(field_name, Field2d)
 
     ELSE 
@@ -1170 +1220 @@
                                 is_sequential, klon_mpi_begin, klon_mpi_end, &
                                 jj_nb, klon_mpi
-  USE wxios, only: wxios_write_3D
+  USE xios, only: xios_send_field
 
 
@@ -1204 +1254 @@
         ALLOCATE(index3d(iim*jj_nb*nlev))
         ALLOCATE(fieldok(iim*jj_nb,nlev))
-        CALL wxios_write_3D(field_name, Field3d(:,:,1:klev))
+        CALL xios_send_field(field_name, Field3d(:,:,1:nlev))
                         
     ELSE