Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

Timestamp:

2015-12-03T09:10:32+01:00 (8 years ago)

Author:

deazer

Message:

Merging TMB and 25h diagnostics to head of trunk
added brief documentation

File:

• branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90 (modified) (8 diffs)

branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

@@ -4 +4 @@
    !! Coupled O/A : coupled ocean-atmosphere case using OASIS3-MCT
    !!=====================================================================
-   !! History :   
-   !!   9.0  !  04-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
-   !!   " "  !  04-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
-   !!   " "  !  04-11  (V. Gayler, MPI M&D) Grid writing
-   !!   " "  !  05-08  (R. Redler, W. Park) frld initialization, paral(2) revision
-   !!   " "  !  05-09  (R. Redler) extended to allow for communication over root only
-   !!   " "  !  06-01  (W. Park) modification of physical part
-   !!   " "  !  06-02  (R. Redler, W. Park) buffer array fix for root exchange
-   !!   3.4  !  11-11  (C. Harris) Changes to allow mutiple category fields
-   !!----------------------------------------------------------------------
-   !!----------------------------------------------------------------------
-   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3
+   !! History :  1.0  !  2004-06  (R. Redler, NEC Laboratories Europe, Germany) Original code
+   !!             -   !  2004-11  (R. Redler, NEC Laboratories Europe; N. Keenlyside, W. Park, IFM-GEOMAR, Germany) revision
+   !!             -   !  2004-11  (V. Gayler, MPI M&D) Grid writing
+   !!            2.0  !  2005-08  (R. Redler, W. Park) frld initialization, paral(2) revision
+   !!             -   !  2005-09  (R. Redler) extended to allow for communication over root only
+   !!             -   !  2006-01  (W. Park) modification of physical part
+   !!             -   !  2006-02  (R. Redler, W. Park) buffer array fix for root exchange
+   !!            3.4  !  2011-11  (C. Harris) Changes to allow mutiple category fields
+   !!            3.6  !  2014-11  (S. Masson) OASIS3-MCT
+   !!----------------------------------------------------------------------
+   
+   !!----------------------------------------------------------------------
+   !!   'key_oasis3'                    coupled Ocean/Atmosphere via OASIS3-MCT
+   !!   'key_oa3mct_v3'                 to be added for OASIS3-MCT version 3
    !!----------------------------------------------------------------------
    !!   cpl_init     : initialization of coupled mode communication
    !!   cpl_define   : definition of grid and fields
-   !!   cpl_snd     : snd out fields in coupled mode
-   !!   cpl_rcv     : receive fields in coupled mode
+   !!   cpl_snd      : snd out fields in coupled mode
+   !!   cpl_rcv      : receive fields in coupled mode
    !!   cpl_finalize : finalize the coupled mode communication
    !!----------------------------------------------------------------------
@@ -61 +63 @@
 #endif
 
-   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=40        ! Maximum number of coupling fields
+   INTEGER                    ::   nrcv         ! total number of fields received 
+   INTEGER                    ::   nsnd         ! total number of fields sent 
+   INTEGER                    ::   ncplmodel    ! Maximum number of models to/from which NEMO is potentialy sending/receiving data
+   INTEGER, PUBLIC, PARAMETER ::   nmaxfld=50   ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields
    INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields
@@ -86 +91 @@
 CONTAINS
 
-   SUBROUTINE cpl_init( kl_comm )
+   SUBROUTINE cpl_init( cd_modname, kl_comm )
       !!-------------------------------------------------------------------
       !!             ***  ROUTINE cpl_init  ***
@@ -95 +100 @@
       !! ** Method  :   OASIS3 MPI communication 
       !!--------------------------------------------------------------------
-      INTEGER, INTENT(out) ::   kl_comm   ! local communicator of the model
+      CHARACTER(len = *), INTENT(in   ) ::   cd_modname   ! model name as set in namcouple file
+      INTEGER           , INTENT(  out) ::   kl_comm      ! local communicator of the model
       !!--------------------------------------------------------------------
 
@@ -104 +110 @@
       ! 1st Initialize the OASIS system for the application
       !------------------------------------------------------------------
-      CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror )
+      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror )
       IF ( nerror /= OASIS_Ok ) &
          CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp')
@@ -144 +150 @@
       IF(lwp) WRITE(numout,*)
 
+      ncplmodel = kcplmodel
       IF( kcplmodel > nmaxcpl ) THEN
-         CALL oasis_abort ( ncomp_id, 'cpl_define', 'kcplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'ncplmodel is larger than nmaxcpl, increase nmaxcpl')   ;   RETURN
+      ENDIF
+
+      nrcv = krcv
+      IF( nrcv > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nrcv is larger than nmaxfld, increase nmaxfld')   ;   RETURN
+      ENDIF
+
+      nsnd = ksnd
+      IF( nsnd > nmaxfld ) THEN
+         CALL oasis_abort ( ncomp_id, 'cpl_define', 'nsnd is larger than nmaxfld, increase nmaxfld')   ;   RETURN
       ENDIF
       !
@@ -400 +417 @@
 
 
-   INTEGER FUNCTION cpl_freq( kid )  
+   INTEGER FUNCTION cpl_freq( cdfieldname )  
       !!---------------------------------------------------------------------
       !!              ***  ROUTINE cpl_freq  ***
@@ -406 +423 @@
       !! ** Purpose : - send back the coupling frequency for a particular field
       !!----------------------------------------------------------------------
-      INTEGER,INTENT(in) ::   kid   ! variable index
-      !!
+      CHARACTER(len = *), INTENT(in) ::   cdfieldname    ! field name as set in namcouple file
+      !!
+      INTEGER               :: id
       INTEGER               :: info
       INTEGER, DIMENSION(1) :: itmp
+      INTEGER               :: ji,jm     ! local loop index
+      INTEGER               :: mop
       !!----------------------------------------------------------------------
-      CALL oasis_get_freqs(kid, 1, itmp, info)
-      cpl_freq = itmp(1)
+      cpl_freq = 0   ! defaut definition
+      id = -1        ! defaut definition
+      !
+      DO ji = 1, nsnd
+         IF (ssnd(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN
+                     id = ssnd(ji)%nid(1,jm)
+                     mop = OASIS_Out
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      DO ji = 1, nrcv
+         IF (srcv(ji)%laction ) THEN
+            DO jm = 1, ncplmodel
+               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN
+                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN
+                     id = srcv(ji)%nid(1,jm)
+                     mop = OASIS_In
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDDO
+      !
+      IF( id /= -1 ) THEN
+#if defined key_oa3mct_v3
+         CALL oasis_get_freqs(id, mop, 1, itmp, info)
+#else
+         CALL oasis_get_freqs(id,      1, itmp, info)
+#endif
+         cpl_freq = itmp(1)
+      ENDIF
       !
    END FUNCTION cpl_freq