MODULE lib_io_fdir
   !!======================================================================
   !!   ???
   !!======================================================================
#if defined key_fdir
   !!======================================================================
   !!  IO Routines for OPA
   !!
   !!  read2     read a direct access 2D field (jpiglo,jpjglo)
   !!  read2d    read a direct access 2D field (jpidta,jpjdta)
   !!  read3     read a direct access 3D field (jpiglo,jpjglo,jpk)
   !!  read3d    read a direct access 3D field (jpidta,jpjdta,jpk)
   !!
   !!  write2    write a direct access 2D field (jpiglo,jpjglo)
   !!  write3    write a direct access 3D field (jpiglo,jpjglo,jpk)
   !!  write4    write a 4bytes direct access 2D field (jpiglo,jpjglo)
   !!
   !!======================================================================
   !! * Modules used
   USE dom_oce         ! ocean space and time domain 
   USE lib_mpp         ! distributed memory computing library

   IMPLICIT NONE

   !! * Module variables
   INTEGER, PARAMETER ::            &
      jpkmod  = 1 + (jpk-1)/jpnij      ! used for mpp outputs

   REAL(wp), DIMENSION(jpi,jpj,jpnij,jpkmod) ::   &
      tabio              ! i/o workspace array
   REAL(wp), DIMENSION(jpiglo,jpjglo) ::   &
      tabglo             ! global auxilary array
   REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
      tabdta             ! global auxilary array
   !!----------------------------------------------------------------------
   !!   OPA 9.0 , LODYC-IPSL  (2003)
   !!----------------------------------------------------------------------

CONTAINS

   SUBROUTINE read2( kunit, ptab, kdim, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE read2  ***
   !!      
   !! ** Purpose :   Opa standard input for a 2D array
   !!
   !! ** Method : - Read a binary array ( direct access file )
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! History
   !!      original  : 93-09 (M. Imbard)
   !!      additions : 96-05 (J. Escobar)
   !!----------------------------------------------------------------------
   !! * Arguments
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &
         kdim ,       &  ! record length
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
   !! * Local declarations
      INTEGER ji, jj, jproc   ! dummy loop indices
      INTEGER imess, ic
      INTEGER ilci, ilcj, iilb, ijlb
   !!---------------------------------------------------------------------

   ! 1. Read global array
   ! --------------------

   ! only the main processor

      IF( narea == 1 ) THEN
         READ(kunit,REC=kdim*(krec-1)+1) tabglo
         DO jproc = 1, jpnij
            ilci = nlcit (jproc)
            ilcj = nlcjt (jproc)
            iilb = nimppt(jproc)
            ijlb = njmppt(jproc)
            DO jj = 1, ilcj
               DO ji = 1, ilci
                  tabio(ji,jj,jproc,1) = tabglo(ji+iilb-1,jj+ijlb-1)
               END DO
             END DO
         END DO
      ENDIF
      CALL mppsync

   ! 2. Scaterring of auxilary array
   ! -------------------------------

      CALL mppscatter( tabio, 1, 0, ptab )
      CALL mppsync

      ! mask
      DO jj = nlcj+1, jpj
         DO ji = 1, nlci
            ptab(ji,jj) = 0.e0
         END DO
      END DO
      DO ji = nlci+1, jpi
         ptab(ji,:) = 0.e0
      END DO
      CALL mppsync

#  else
     READ(kunit,REC=kdim*(krec-1)+1) ptab
#endif

   END SUBROUTINE read2


   SUBROUTINE read2d( kunit, ptab, kdim, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE read2D  ***
   !!
   !! ** Purpose :   Opa standard input for a 2D data array
   !!     (its possible to read only a subdomain - zoom )
   !!
   !! ** Method  :   Read a binary array ( direct access file )
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! ** Action :
   !!
   !! History :
   !!      original  : 93-09 (M. Imbard)
   !!      additions : 96-05 (j. Escobar)
   !!      additions : 98-11 (J. Vialard) vpp
   !!----------------------------------------------------------------------
   !! * Arguments 
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &      
         kdim ,       &  ! record length
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
      INTEGER ji, jj, jproc
      INTEGER imess, ic
      INTEGER ilci, ilcj, iilb, ijlb
   !!---------------------------------------------------------------------


   ! 1. Read global array
   ! --------------------

   ! only the main processor

      IF( narea == 1 ) THEN
         READ(kunit,REC=kdim*(krec-1)+1) tabdta
         DO jproc=1,jpnij
            ilci = nlcit (jproc)
            ilcj = nlcjt (jproc)
            iilb = nimppt(jproc)
            ijlb = njmppt(jproc)
            DO jj = 1, ilcj
               DO ji = 1, ilci
                  tabio(ji,jj,jproc,1)=tabdta(ji+jpizoom-1+iilb-1,jj+jpjzoom-1+ijlb-1)
               END DO
            END DO
         END DO
      ENDIF
      CALL mppsync

   ! 2. Scaterring of auxilary array
   ! -------------------------------

      CALL mppscatter( tabio, 1, 0, ptab )

   ! mask

      DO jj = nlcj+1, jpj
         DO ji = 1, nlci
            ptab(ji,jj) = 0.e0
         END DO
      END DO
      DO ji = nlci+1, jpi
         ptab(ji,:) = 0.e0
      END DO
      CALL mppsync

#  else

      INTEGER ji, jj

      READ(kunit,REC=kdim*(krec-1)+1) tabdta
      DO jj = 1, jpj
        DO ji = 1, jpi
          ptab(ji,jj) = tabdta( mig(ji), mjg(jj) )
        END DO
      END DO
#endif

  END SUBROUTINE read2d


   SUBROUTINE read3( kunit, ptab, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE read3  ***
   !!                 
   !! ** Purpose :   Opa standard input for a 3d array
   !!
   !! ** Method  :   Read a binary array ( direct access FILE )
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! ** Action :
   !!
   !! History :
   !!      original  : 93-09 (M. Imbard)
   !!----------------------------------------------------------------------
   !! * Arguments 
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &      
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
      INTEGER ji, jj, jk, jproc
      INTEGER ikloc, ikpe
      INTEGER ilci, ilcj, iilb, ijlb
   !!---------------------------------------------------------------------


   ! 1. Read horizontal slab by horizontal slab
   ! -------------------------------------------
   ! each slab is associed with a processor
   ! the input is read in a auxilary array

      DO jk = 1, jpk
        ikloc = 1 + (jk-1) / jpnij
        ikpe  = 1 + MOD( jk-1, jpnij )
        IF( narea == ikpe ) THEN
            READ(kunit,REC=jpk*(krec-1)+jk) tabglo
            DO jproc = 1, jpnij
              ilci = nlcit (jproc)
              ilcj = nlcjt (jproc)
              iilb = nimppt(jproc)
              ijlb = njmppt(jproc)
              DO jj = 1, ilcj
                DO ji = 1, ilci
                  tabio(ji,jj,jproc,ikloc) = tabglo(ji+iilb-1,jj+ijlb-1)
                END DO
              END DO
            END DO
        ENDIF
      END DO
      CALL mppsync

   ! 2. Scaterring of auxilary array
   ! -------------------------------

      DO jk = 1,jpk
        ikloc = 1 + (jk-1) / jpnij
        ikpe  = 1 + MOD( jk-1, jpnij )
        CALL mppscatter( tabio(1,1,1,ikloc), jk, ikpe-1, ptab(1,1,jk) )

   ! mask

        DO jj = nlcj+1, jpj
          DO ji = 1, nlci
            ptab(ji,jj,jk) = 0.e0
          END DO
        END DO
        DO ji = nlci+1, jpi
          DO jj = 1, jpj
            ptab(ji,jj,jk) = 0.e0
          END DO
        END DO
      END DO
      CALL mppsync

#  else

      INTEGER jk

      DO jk = 1, jpk
         READ(kunit,REC=jpk*(krec-1)+jk) tabglo
         ptab(:,:,jk) = tabglo(:,:)
      END DO
#endif

   END SUBROUTINE read3


   SUBROUTINE read3d( kunit, ptab, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE read3D  ***
   !!  
   !! ** Purpose :   Opa standard input for a 3D data array
   !!     (its possible to read only a subdomain - zoom )
   !!
   !! ** Method  :   Read a binary array ( direct access file )
   !!      IF key_mpp is used, write with an auxilary array
   !!
   !! ** Action :
   !!
   !! History :
   !!      original  : 93-09 (M. Imbard)
   !!      additions : 98-11 (J. Vialard) vpp
   !!----------------------------------------------------------------------
   !! * Arguments 
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &      
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
      INTEGER ji, jj, jk, jproc
      INTEGER ikloc, ikpe
      INTEGER ilci, ilcj, iilb, ijlb
   !!---------------------------------------------------------------------


   ! 1. Read horizontal slab by horizontal slab
   ! -------------------------------------------
   ! each slab is associed with a processor
   ! the input is read in a auxilary array

      DO jk = 1,jpk
        ikloc = 1 + (jk-1) / jpnij
        ikpe  = 1 + MOD( jk-1, jpnij )
        IF( narea == ikpe ) THEN
            READ(kunit,REC=jpk*(krec-1)+jk) tabdta
            DO jproc = 1, jpnij
              ilci = nlcit (jproc)
              ilcj = nlcjt (jproc)
              iilb = nimppt(jproc)
              ijlb = njmppt(jproc)
              DO jj = 1, ilcj
                DO ji = 1, ilci
                  tabio(ji,jj,jproc,ikloc) = tabdta(ji+jpizoom-1+iilb-1,jj+jpjzoom-1+ijlb-1)
                END DO
              END DO
            END DO
        ENDIF
      END DO
      CALL mppsync

   ! 2. Scaterring of auxilary array
   ! -------------------------------

      DO jk = 1, jpk
         ikloc = 1 + (jk-1) / jpnij
         ikpe  = 1 + MOD( jk-1, jpnij )
         CALL mppscatter( tabio(1,1,1,ikloc), jk, ikpe-1, ptab(1,1,jk) )

   ! mask

         DO jj = nlcj+1, jpj
            DO ji = 1,nlci
               ptab(ji,jj,jk) = 0.e0
            END DO
         END DO
         DO ji = nlci+1, jpi
            ptab(ji,:,jk) = 0.e0
         END DO
      END DO
      CALL mppsync

#  else

      INTEGER ji, jj, jk

      DO jk = 1, jpk
         READ(kunit,REC=jpk*(krec-1)+jk) tabdta
         DO jj = 1, jpj
            DO ji = 1, jpi
               ptab(ji,jj,jk) = tabdta( mig(ji), mjg(jj) )
            END DO
         END DO
      END DO
#endif

   END SUBROUTINE read3d


   SUBROUTINE write2( kunit, ptab, kdim, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE write2  ***
   !!
   !! ** Purpose :   OPA standard output for a 2D array
   !!
   !! ** Method  :   write a binary array
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! History :
   !!       original  : 93-09 (M. Imbard)
   !!       additions : 96-05 (J. Escobar)
   !!----------------------------------------------------------------------
   !! * Arguments 
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &      
         kdim ,       &  ! record length
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
      INTEGER ji,jj,jproc
      INTEGER ildi,ilei,ildj,ilej
      INTEGER iilb,ijlb
   !!---------------------------------------------------------------------


      tabglo(:,:) = 0.e0

   ! 1. Receive of each subdomain array
   ! ----------------------------------
   ! processor position dependance
   ! the main processor 0 receive each contribution

      CALL mppgather( ptab, 1, 0, tabio )
      CALL mppsync


   ! 2. Write
   ! --------

   ! only the main processor

      IF( narea == 1 ) THEN

   !  write in an global auxilary array
         DO jproc = 1, jpnij
            ildi = nldit (jproc)   
            ilei = nleit (jproc)   
            ildj = nldjt (jproc)   
            ilej = nlejt (jproc)   
            iilb = nimppt(jproc)
            ijlb = njmppt(jproc)
            DO jj = ildj, ilej
               DO ji = ildi, ilei
                  tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,1)
               END DO
            END DO
         END DO

   ! global periodicity
         IF( jperio == 1 ) THEN
            tabglo(  1   ,:) = tabglo(jpiglo-1,:)
            tabglo(jpiglo,:) = tabglo(   2    ,:)
         ENDIF

   ! write
          WRITE(kunit,REC=kdim*(krec-1)+1) tabglo

      ENDIF

      CALL mppsync

#  else
      WRITE(kunit,REC=kdim*(krec-1)+1) ptab
#endif

   END SUBROUTINE write2


   SUBROUTINE write3( kunit, ptab, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE write3  ***
   !!             
   !! ** Purpose :   OPA standard output for a 3D array
   !!
   !! ** Method  :   write a binary array
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! ** Action :
   !!
   !! History :
   !!       original  : 93-09 (M. Imbard)
   !!       additions : 96-05 (J. Escobar)
   !!----------------------------------------------------------------------
   !! * Arguments 
      INTEGER , INTENT( in  ) ::   &
         kunit           ! output unit
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
         ptab            ! variable array
      INTEGER , INTENT( in  ) ::   &      
         krec            ! record unit for direct access file

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
      INTEGER ji,jj,jk,jproc
      INTEGER ikloc,ikpe
      INTEGER ildi,ilei,ildj,ilej
      INTEGER iilb,ijlb
   !!---------------------------------------------------------------------

      tabglo(:,:) = 0.e0


   ! 1. Receive of each subdomain array
   ! ----------------------------------
   ! processor position dependance
   ! each processor receive the vertical slab which is attributed to it

      DO jk = 1, jpk
         ikloc = 1 + (jk-1) / jpnij
         ikpe  = 1 + MOD( jk-1, jpnij )
         CALL mppgather( ptab(1,1,jk), jk, ikpe-1, tabio(1,1,1,ikloc) )
      END DO
      CALL mppsync


   ! 2. Write horizontal slab by horizontal slab
   ! -------------------------------------------

      DO jk = 1, jpk
         ikloc = 1 + (jk-1) / jpnij
         ikpe  = 1 + MOD( jk-1, jpnij )
         IF( narea == ikpe ) THEN

   !  write in an global auxilary array

            DO jproc = 1, jpnij
               ildi = nldit (jproc)   
               ilei = nleit (jproc)   
               ildj = nldjt (jproc)   
               ilej = nlejt (jproc)   
               iilb = nimppt(jproc)
               ijlb = njmppt(jproc)
               DO jj = ildj,ilej
                  DO ji = ildi,ilei
                     tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,ikloc)
                  END DO
               END DO
            END DO

   ! global periodicity

            IF( jperio == 1 ) THEN
               tabglo(  1   ,:) = tabglo(jpiglo-1,:)
               tabglo(jpiglo,:) = tabglo(   2    ,:)
            ENDIF

   ! write

            WRITE(kunit,REC=jpk*(krec-1)+jk) tabglo
        ENDIF
      END DO
      CALL mppsync

#  else

      INTEGER  ::   ji,jj,jk
      REAL(wp) ::   ztab(jpi,jpj)

      DO jk = 1,jpk
         ztab(:,:) = ptab(:,:,jk)
         WRITE(kunit,REC=jpk*(krec-1)+jk) ztab
      END DO
#endif

      END SUBROUTINE write3


      SUBROUTINE write4( kunit, ptab, krec )
   !!---------------------------------------------------------------------
   !!                  ***  ROUTINE write4  ***
   !!        
   !! ** Purpose :   OPA ieee 4 bytes output for a 3D array
   !!
   !! ** Method  :   write a binary array
   !!      If key_mpp is used, write with an auxilary array
   !!
   !! History :
   !!       original  : 93-09 (M. Imbard)
   !!       additions : 96-05 (J. Escobar)
   !!      additions : 98-11 (J. Vialard) vpp
   !!----------------------------------------------------------------------
   !! * Arguments
      INTEGER , INTENT( in  ) ::   &
         kunit,       &  ! output unit
         krec            ! record unit for direct access file
      REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) ::   &
         ptab            ! variable array

#if defined key_mpp_mpi   ||   defined key_mpp_shmem
   !! * Local declarations
      INTEGER jk, jproc
      INTEGER ikloc, ikpe
      INTEGER ildi,ilei,ildj,ilej
      INTEGER iilb,ijlb
   !!---------------------------------------------------------------------

      tabglo(:,:) = 0.e0


   ! 1. Receive of each subdomain array
   ! ----------------------------------
   ! processor position dependance
   ! each processor receive the vertical slab which is attributed to it

      DO jk = 1, jpk
         ikloc = 1 + (jk-1) / jpnij
         ikpe  = 1 + MOD( jk-1, jpnij )
         CALL mppgather( ptab(1,1,jk), jk, ikpe-1, tabio(1,1,1,ikloc) )
      END DO
      CALL mppsync


   ! 2. Write horizontal slab by horizontal slab
   ! -------------------------------------------

      DO jk = 1, jpk
         ikloc = 1 + ( jk - 1 ) / jpnij
         ikpe  = 1 + MOD( jk-1, jpnij )
         IF( narea == ikpe ) THEN

         ! write in an global auxilary array
            DO jproc = 1, jpnij
               ildi = nldit (jproc)   
               ilei = nleit (jproc)   
               ildj = nldjt (jproc)   
               ilej = nlejt (jproc)   
               iilb = nimppt(jproc)
               ijlb = njmppt(jproc)
               DO jj = ildj, ilej
                  DO ji = ildi, ilei
                     tabglo(ji+iilb-1,jj+ijlb-1) = tabio(ji,jj,jproc,ikloc)
                  END DO
               END DO
            END DO

         ! global periodicity
            IF( jperio == 1 ) THEN
               tabglo(  1   ,:) = tabglo(jpiglo-1,:)
               tabglo(jpiglo,:) = tabglo(   2    ,:)
            ENDIF

   ! write
            WRITE(kunit,REC=jpk*(krec-1)+jk) tabglo
        ENDIF
      END DO
      CALL mppsync

#  else

      INTEGER jk
      REAL(wp), DIMENSION(jpi,jpj) ::   ztab

      DO jk = 1, jpk
         ztab(:,:) = ptab(:,:,jk)
         WRITE(kunit,REC=jpk*(krec-1)+jk) ztab
      END DO
#endif

   END SUBROUTINE write4

   !!======================================================================
#endif
END MODULE lib_io_fdir