Changeset 11405 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/fldread.F90

Timestamp:

2019-08-06T15:16:49+02:00 (5 years ago)

Author:

andmirek

Message:

ticket #2195: read weights for blk using XIOS

File:

• NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/fldread.F90 (modified) (11 diffs)

NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/SBC/fldread.F90

@@ -647 +647 @@
          ENDIF        
       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN
-         CALL wgt_list( sdjf, iw )
+         CALL wgt_list( sdjf, iw, lxios_blkw )
          IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2),          & 
             &                                                                          sdjf%nrec_a(1), sdjf%lsmname )
@@ -1345 +1345 @@
 
 
-   SUBROUTINE wgt_list( sd, kwgt )
+   SUBROUTINE wgt_list( sd, kwgt, ldxios )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE wgt_list  ***
@@ -1355 +1355 @@
       TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file
       INTEGER    , INTENT(inout) ::   kwgt      ! index of weights
+      LOGICAL    , INTENT(in), OPTIONAL :: ldxios
       !
       INTEGER ::   kw, nestid   ! local integer
       LOGICAL ::   found        ! local logical
+      LOGICAL ::   luxios
+      luxios = .FALSE.
+      if(PRESENT(ldxios)) luxios = ldxios
       !!----------------------------------------------------------------------
       !
@@ -1381 +1385 @@
       IF( .NOT.found ) THEN
          kwgt = nxt_wgt
-         CALL fld_weight( sd )
+         CALL fld_weight( sd, luxios )
       ENDIF
       !
@@ -1416 +1420 @@
 
 
-   SUBROUTINE fld_weight( sd )
+   SUBROUTINE fld_weight( sd, ldxios )
       !!---------------------------------------------------------------------
       !!                    ***  ROUTINE fld_weight  ***
@@ -1424 +1428 @@
       !!----------------------------------------------------------------------
       TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file
+      LOGICAL, INTENT(in), OPTIONAL :: ldxios
       !!
       INTEGER ::   jn         ! dummy loop indices
@@ -1435 +1440 @@
       INTEGER,  DIMENSION(jpi,jpj) ::   data_src
       REAL(wp), DIMENSION(jpi,jpj) ::   data_tmp
+      LOGICAL                      ::   luxios
       !!----------------------------------------------------------------------
+      luxios = .FALSE.
+      IF(PRESENT(ldxios)) luxios = ldxios
       !
       IF( nxt_wgt > tot_wgts ) THEN
@@ -1464 +1472 @@
       CALL iom_open ( sd%wgtname, inum )   ! interpolation weights
       IF ( inum > 0 ) THEN
-
+         IF(luxios) THEN 
+            CALL iom_swap(cbwxios_context)
+         ENDIF
          !! determine whether we have an east-west cyclic grid
          !! from global attribute called "ew_wrap" in the weights file
@@ -1511 +1521 @@
             WRITE(aname,'(a3,i2.2)') 'src',jn
             data_tmp(:,:) = 0
-            CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) )
+            IF(luxios) THEN
+               CALL iom_get ( inum, jpdom_data, aname//TRIM(sd%wgtname), data_tmp(:,:), ldxios = luxios )
+            ELSE
+               CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) )
+            ENDIF
             data_src(:,:) = INT(data_tmp(:,:))
             ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1)
@@ -1521 +1535 @@
             WRITE(aname,'(a3,i2.2)') 'wgt',jn
             ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0
-            CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) )
+            IF(luxios) THEN
+               CALL iom_get ( inum, jpdom_data, aname//TRIM(sd%wgtname), ref_wgts(nxt_wgt)%data_wgt(:,:,jn), ldxios = luxios )
+            ELSE
+               CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) )
+            ENDIF
          END DO
          CALL iom_close (inum)
@@ -1548 +1566 @@
          nxt_wgt = nxt_wgt + 1
          !
+         IF(luxios) CALL iom_swap(cxios_context)
       ELSE 
          CALL ctl_stop( '    fld_weight : unable to read the file ' )