Changeset 2408 for LMDZ5/branches/testing/libf/phylmd/oasis.F90

Timestamp:

Dec 14, 2015, 11:43:09 AM (8 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r2298:2396 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/oasis.F90 (modified) (21 diffs)

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

@@ -99 +99 @@
     USE wxios, ONLY : wxios_context_init 
 #endif
-
-
-    INCLUDE "dimensions.h"
-    INCLUDE "iniprint.h"
+    USE print_control_mod, ONLY: lunout
+    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
 
 ! Local variables
@@ -218 +216 @@
        IF (ierror .NE. PRISM_Ok) THEN
           abort_message=' Probleme init dans prism_init_comp '
-          CALL abort_gcm(modname,abort_message,1)
+          CALL abort_physic(modname,abort_message,1)
        ELSE
           WRITE(lunout,*) 'inicma : init psmile ok '
@@ -229 +227 @@
 !************************************************************************************
     ig_paral(1) = 1                            ! apple partition for //
-    ig_paral(2) = (jj_begin-1)*iim+ii_begin-1  ! offset
-    ig_paral(3) = (jj_end*iim+ii_end) - (jj_begin*iim+ii_begin) + 1
-
-    IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+iim-1
+    ig_paral(2) = (jj_begin-1)*nbp_lon+ii_begin-1  ! offset
+    ig_paral(3) = (jj_end*nbp_lon+ii_end) - (jj_begin*nbp_lon+ii_begin) + 1
+
+    IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+nbp_lon-1
     WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)
     
@@ -240 +238 @@
     IF (ierror .NE. PRISM_Ok) THEN
        abort_message=' Probleme dans prism_def_partition '
-       CALL abort_gcm(modname,abort_message,1)
+       CALL abort_physic(modname,abort_message,1)
     ELSE
        WRITE(lunout,*) 'inicma : decomposition domaine psmile ok '
@@ -249 +247 @@
 
     il_var_actual_shape(1) = 1
-    il_var_actual_shape(2) = iim
+    il_var_actual_shape(2) = nbp_lon
     il_var_actual_shape(3) = 1
-    il_var_actual_shape(4) = jjm+1
+    il_var_actual_shape(4) = nbp_lat
    
     il_var_type = PRISM_Real
@@ -268 +266 @@
                   inforecv(jf)%name
              abort_message=' Problem in call to prism_def_var_proto for fields to receive'
-             CALL abort_gcm(modname,abort_message,1)
+             CALL abort_physic(modname,abort_message,1)
           ENDIF
        ENDIF
@@ -286 +284 @@
                   infosend(jf)%name
              abort_message=' Problem in call to prism_def_var_proto for fields to send'
-             CALL abort_gcm(modname,abort_message,1)
+             CALL abort_physic(modname,abort_message,1)
           ENDIF
        ENDIF
@@ -297 +295 @@
     IF (ierror .NE. PRISM_Ok) THEN
        abort_message=' Problem in call to prism_endef_proto'
-       CALL abort_gcm(modname,abort_message,1)
+       CALL abort_physic(modname,abort_message,1)
     ELSE
        WRITE(lunout,*) 'inicma : endef psmile ok '
@@ -320 +318 @@
 !======================================================================
 !
-    INCLUDE "dimensions.h"
-    INCLUDE "iniprint.h"
+    USE print_control_mod, ONLY: lunout
+    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
 ! Input arguments
 !************************************************************************************
@@ -328 +326 @@
 ! Output arguments
 !************************************************************************************
-    REAL, DIMENSION(iim, jj_nb,maxrecv), INTENT(OUT) :: tab_get
+    REAL, DIMENSION(nbp_lon, jj_nb,maxrecv), INTENT(OUT) :: tab_get
 
 ! Local variables
@@ -336 +334 @@
     CHARACTER (len = 20)          :: modname = 'fromcpl'
     CHARACTER (len = 80)          :: abort_message 
-    REAL, DIMENSION(iim*jj_nb)    :: field
+    REAL, DIMENSION(nbp_lon*jj_nb)    :: field
 
 !************************************************************************************
@@ -345 +343 @@
     istart=ii_begin
     IF (is_south_pole) THEN
-       iend=(jj_end-jj_begin)*iim+iim
+       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
     ELSE
-       iend=(jj_end-jj_begin)*iim+ii_end
+       iend=(jj_end-jj_begin)*nbp_lon+ii_end
     ENDIF
     
@@ -354 +352 @@
           field(:) = -99999.
           CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror)
-          tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/))
+          tab_get(:,:,i) = RESHAPE(field(:),(/nbp_lon,jj_nb/))
        
           IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. &
@@ -362 +360 @@
               WRITE (lunout,*)  'Error with receiving filed : ', inforecv(i)%name, ktime   
               abort_message=' Problem in prism_get_proto '
-              CALL abort_gcm(modname,abort_message,1)
+              CALL abort_physic(modname,abort_message,1)
           ENDIF
       ENDIF
@@ -382 +380 @@
 !
 ! 
-    INCLUDE "dimensions.h"
-    INCLUDE "iniprint.h"
+    USE print_control_mod, ONLY: lunout
+    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat
 ! Input arguments
 !************************************************************************************
     INTEGER, INTENT(IN)                              :: ktime
     LOGICAL, INTENT(IN)                              :: last
-    REAL, DIMENSION(iim, jj_nb, maxsend), INTENT(IN) :: tab_put
+    REAL, DIMENSION(nbp_lon, jj_nb, maxsend), INTENT(IN) :: tab_put
 
 ! Local variables
@@ -396 +394 @@
     INTEGER                          :: wstart,wend
     INTEGER                          :: ierror, i
-    REAL, DIMENSION(iim*jj_nb)       :: field
+    REAL, DIMENSION(nbp_lon*jj_nb)       :: field
     CHARACTER (len = 20),PARAMETER   :: modname = 'intocpl'
     CHARACTER (len = 80)             :: abort_message 
@@ -411 +409 @@
     istart=ii_begin
     IF (is_south_pole) THEN
-       iend=(jj_end-jj_begin)*iim+iim
+       iend=(jj_end-jj_begin)*nbp_lon+nbp_lon
     ELSE
-       iend=(jj_end-jj_begin)*iim+ii_end
+       iend=(jj_end-jj_begin)*nbp_lon+ii_end
     ENDIF
     
@@ -419 +417 @@
        wstart=istart
        wend=iend
-       IF (is_north_pole) wstart=istart+iim-1
-       IF (is_south_pole) wend=iend-iim+1
+       IF (is_north_pole) wstart=istart+nbp_lon-1
+       IF (is_south_pole) wend=iend-nbp_lon+1
        
        DO i = 1, maxsend
           IF (infosend(i)%action) THEN
-             field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
+             field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
              CALL writefield_phy(infosend(i)%name,field(wstart:wend),1)
           END IF
@@ -436 +434 @@
     DO i = 1, maxsend
       IF (infosend(i)%action .AND. infosend(i)%nid .NE. -1 ) THEN
-          field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/))
+          field = RESHAPE(tab_put(:,:,i),(/nbp_lon*jj_nb/))
           CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror)
           
@@ -444 +442 @@
               WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime   
               abort_message=' Problem in prism_put_proto '
-              CALL abort_gcm(modname,abort_message,1)
+              CALL abort_physic(modname,abort_message,1)
           ENDIF
       ENDIF
@@ -459 +457 @@
           IF (ierror .NE. PRISM_Ok) THEN
              abort_message=' Problem in prism_terminate_proto '
-             CALL abort_gcm(modname,abort_message,1)
+             CALL abort_physic(modname,abort_message,1)
           ENDIF
        ENDIF