Changeset 1910 for LMDZ5/branches/testing/libf/bibio

Timestamp:

Nov 29, 2013, 9:40:25 AM (11 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r1860:1909 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (2 props)
• libf (modified) (1 prop)
• libf/bibio (modified) (1 prop)
• libf/bibio/arth.F90 (modified) (1 prop)
• libf/bibio/assert_eq_m.F90 (modified) (1 prop)
• libf/bibio/assert_m.F90 (modified) (1 prop)
• libf/bibio/chfev.F (modified) (1 prop)
• libf/bibio/cray.F (modified) (1 prop)
• libf/bibio/fdump.F (modified) (1 prop)
• libf/bibio/formcoord.F (modified) (1 prop)
• libf/bibio/handle_err_m.F90 (modified) (1 prop)
• libf/bibio/i1mach.F (modified) (1 prop)
• libf/bibio/initdynav.F90 (modified) (1 prop)
• libf/bibio/initfluxsto.F (modified) (1 prop)
• libf/bibio/inithist.F (modified) (1 prop)
• libf/bibio/interpolation.F90 (modified) (1 prop)
• libf/bibio/ioipsl_errioipsl.F90 (modified) (1 prop)
• libf/bibio/ioipsl_getincom.F90 (modified) (1 prop)
• libf/bibio/ioipsl_stringop.F90 (modified) (1 prop)
• libf/bibio/ismax.F (modified) (1 prop)
• libf/bibio/ismin.F (modified) (1 prop)
• libf/bibio/j4save.F (modified) (1 prop)
• libf/bibio/misc_mod.F90 (modified) (1 prop)
• libf/bibio/netcdf95.F90 (modified) (1 prop)
• libf/bibio/new_unit_m.F90 (modified) (1 prop)
• libf/bibio/nf95_def_var_m.F90 (modified) (1 prop)
• libf/bibio/nf95_get_att_m.F90 (modified) (1 prop)
• libf/bibio/nf95_get_var_m.F90 (modified) (1 prop)
• libf/bibio/nf95_gw_var_m.F90 (modified) (1 prop)
• libf/bibio/nf95_put_att_m.F90 (modified) (1 prop)
• libf/bibio/nf95_put_var_m.F90 (modified) (1 prop)
• libf/bibio/pchdf.F (modified) (1 prop)
• libf/bibio/pchfe.F (modified) (1 prop)
• libf/bibio/pchfe_95_m.F90 (modified) (1 prop)
• libf/bibio/pchsp.F (modified) (1 prop)
• libf/bibio/pchsp_95_m.F90 (modified) (1 prop)
• libf/bibio/regr1_lint_m.F90 (modified) (1 prop)
• libf/bibio/regr1_step_av_m.F90 (modified) (1 prop)
• libf/bibio/regr3_lint_m.F90 (modified) (1 prop)
• libf/bibio/simple.F90 (modified) (1 prop)
• libf/bibio/vampir.F90 (modified) (1 prop)
• libf/bibio/write_field.F90 (modified) (1 prop)
• libf/bibio/writedynav.F90 (modified) (1 prop)
• libf/bibio/writehist.F (modified) (1 prop)
• libf/bibio/wxios.F90 (modified) (17 diffs, 1 prop)
• libf/bibio/xercnt.F (modified) (1 prop)
• libf/bibio/xerhlt.F (modified) (1 prop)
• libf/bibio/xermsg.F (modified) (1 prop)
• libf/bibio/xerprn.F (modified) (1 prop)
• libf/bibio/xersve.F (modified) (1 prop)
• libf/bibio/xgetua.F (modified) (1 prop)

LMDZ5/branches/testing/libf/bibio/wxios.F90

@@ -121 +121 @@
         INTEGER :: xios_comm
 
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. Initialization"
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
 
 
 
         IF (PRESENT(locom)) THEN
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. ctx=",xios_ctx_name,"local_comm=",locom,",return_comm=",xios_comm
-            CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
-        ELSE
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. ctx=",xios_ctx_name,"return_comm=",outcom
-            CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
+          CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
+        ELSE
+          CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
         END IF
         
         IF (PRESENT(outcom)) THEN
-             outcom = xios_comm
+          outcom = xios_comm
+          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
         END IF
         
@@ -157 +158 @@
         g_ctx = xios_ctx
 
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. Current context is ", g_ctx_name
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
 
         !Une première analyse des héritages:
@@ -191 +192 @@
             CASE('earth_360d')
                 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
-                IF (prt_level >= 10) WRITE(lunout,*) 'Xios. Calendrier terrestre a 360 jours/an'
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
             CASE('earth_365d')
                 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
-                IF (prt_level >= 10) WRITE(lunout,*) 'Xios. Calendrier terrestre a 365 jours/an'
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
             CASE('earth_366d')
                 CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
-                IF (prt_level >= 10) WRITE(lunout,*) 'Xios. Calendrier gregorien'
+                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
             CASE DEFAULT
-                abort_message = 'Xios. Mauvais choix de calendrier'
+                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
                 CALL abort_gcm('Gcm:Xios',abort_message,1)
         END SELECT
@@ -206 +207 @@
         WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") annee, mois, jour
         
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. Initial time: ", date
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Initial time: ", date
         
         CALL xios_set_context_attr_hdl(g_ctx, start_date= date)
@@ -212 +213 @@
         !Et enfin,le pas de temps:
         CALL xios_set_timestep(mdtime)
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. ts=",mdtime
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
     END SUBROUTINE wxios_set_cal
 
@@ -230 +231 @@
                                     ibegin, iend, ii_begin, ii_end, jbegin, jend,       &
                                     data_ni, data_ibegin, data_iend,                    &
-                                    io_lat, io_lon)
+                                    io_lat, io_lon,is_south_pole,mpi_rank)
          
-        IMPLICIT NONE
-        INCLUDE 'iniprint.h'
-
-        CHARACTER (len=*), INTENT(IN) :: dom_id
-        LOGICAL, INTENT(IN) :: is_sequential
-        INTEGER, INTENT(IN) :: ni, nj, ni_glo, nj_glo, ibegin, iend, ii_begin, ii_end, jbegin, jend
-        INTEGER, INTENT(IN) :: data_ni, data_ibegin, data_iend
-        REAL, DIMENSION(:) :: io_lat, io_lon
-        
+
+        IMPLICIT NONE
+        INCLUDE 'iniprint.h'
+
+        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
+        LOGICAL,INTENT(IN) :: is_sequential ! flag
+        INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
+        INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
+        INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
+        INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
+        INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain 
+        INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
+        INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
+        INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
+        INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain 
+        INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
+        INTEGER,INTENT(IN) :: data_ni
+        INTEGER,INTENT(IN) :: data_ibegin
+        INTEGER,INTENT(IN) :: data_iend
+        REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
+        REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
+        logical,intent(in) :: is_south_pole ! does this process include the south pole?
+        integer,intent(in) :: mpi_rank ! rank of process
         
         TYPE(xios_domain) :: dom
@@ -251 +266 @@
         CALL xios_get_domain_handle(dom_id, dom)
         
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. Size lon:", SIZE(io_lon(ibegin:iend)), " lat:", SIZE(io_lat(jbegin:jend))
+        IF (prt_level >= 10) THEN
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
+          WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
+        ENDIF
         
         !On parametrise le domaine:
@@ -262 +280 @@
         IF (.NOT.is_sequential) THEN
             mask(:,:)=.TRUE.
-            mask(1:ii_begin-1,1) = .FALSE.
-            mask(ii_end+1:ni,nj) = .FALSE.
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. mask"
-            !CALL xios_set_domain_attr_hdl(dom, mask=mask)
+            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
+            if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
+            ! special case for south pole
+            if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
+            IF (prt_level >= 10) THEN
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
+              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
+            ENDIF
+            CALL xios_set_domain_attr_hdl(dom, mask=mask)
         END IF
 
@@ -271 +294 @@
         !Vérification:
         IF (xios_is_valid_domain(dom_id)) THEN
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Domain initialized: ", dom_id, boool
-        ELSE
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Invalid domain: ", dom_id
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
+        ELSE
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
         END IF
     END SUBROUTINE wxios_domain_param
@@ -307 +330 @@
         !Vérification:
         IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Axis created: ", TRIM(ADJUSTL(axis_id))
-        ELSE
-            WRITE(*,*) "Xios. Invalid axis: ", TRIM(ADJUSTL(axis_id))
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
+        ELSE
+            WRITE(*,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
         END IF
 
@@ -344 +367 @@
         
             IF (xios_is_valid_file("X"//fname)) THEN
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. New file: ", "X"//fname
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
             ELSE
-                WRITE(*,*) "Xios. Error, invalid file: ", "X"//fname
-                WRITE(*,*) "Xios. output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
+                WRITE(*,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
+                WRITE(*,*) "wxios_add_file: output_freq=",TRIM(ADJUSTL(nffreq)),"; output_lvl=",flvl
             END IF
         ELSE
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Fichier ", fname, " défini par XML."
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
                 CALL xios_set_file_attr(fname, enabled=.TRUE.)
         END IF
@@ -360 +383 @@
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
-        USE netcdf
+        USE netcdf, only: nf90_fill_real
 
         IMPLICIT NONE
@@ -385 +408 @@
         !On ajoute le champ:
         CALL xios_add_field(fieldgroup, field, fieldname)
-        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ",fieldname,fieldgroup, fieldlongname, fieldunit
+        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
         
         !On rentre ses paramètres:
         CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ ", fieldname, "cree:"
-        IF (prt_level >= 10) WRITE(lunout,*) "Xios. long_name=",fieldlongname,"; unit=",newunit,";  default_value=",nf90_fill_real
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
+        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
 
     END SUBROUTINE wxios_add_field
@@ -436 +459 @@
         IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
             !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ ", fieldname, "existe via XML"
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
             g_flag_xml = .TRUE.
             g_field_name = fieldname
@@ -443 +466 @@
             !Si premier pssage et champ indéfini, alors on le créé
 
-            IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ ", fieldname, "nexiste pas"
+            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
             
             !On le créé:
             CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
             IF (xios_is_valid_field(fieldname)) THEN
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ ", fieldname, "cree"
+                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
             ENDIF
 
@@ -472 +495 @@
             IF (fdim.EQ.2) THEN
                 !Si c'est un champ 2D:
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ 2D ", fieldname, " de ", "X"//fname ," configure:"
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. op=", TRIM(ADJUSTL(operation))
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. freq_op=1ts","; lvl=",field_level
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                ENDIF
             ELSE
                 !Si 3D :
@@ -480 +505 @@
                 CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
                 
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. Champ 3D ", fieldname, " de ", "X"//fname, "configure:"
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. freq_op=1ts","; lvl=",field_level
-                IF (prt_level >= 10) WRITE(lunout,*) "Xios. axe=",TRIM(ADJUSTL(axis_id))
+                IF (prt_level >= 10) THEN
+                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
+                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
+                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
+                ENDIF
             END IF