Changeset 13443 for NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage2/src/OCE/SBC/sbccpl.F90

Timestamp:

2020-08-28T17:01:04+02:00 (4 years ago)

Author:

frrh

Message:

Commit changes which allow first working 2 way coupling exchanges between GO8
and LFRic aquaplanet.

File:

• NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage2/src/OCE/SBC/sbccpl.F90 (modified) (9 diffs)

NEMO/branches/UKMO/NEMO_4.0.1_NGMS_couple_stage2/src/OCE/SBC/sbccpl.F90

@@ -116 +116 @@
    INTEGER, PARAMETER ::   jpr_tauwy  = 56   ! y component of the ocean stress from waves
    INTEGER, PARAMETER ::   jpr_ts_ice = 57   ! Sea ice surface temp
-
-   INTEGER, PARAMETER ::   jprcv      = 57   ! total number of fields received  
+   INTEGER, PARAMETER ::   jpr_dummy_t = 58  ! Dummy test incoming coupling tracer grid field
+
+   INTEGER, PARAMETER ::   jprcv      = 58   ! total number of fields received  
 
    INTEGER, PARAMETER ::   jps_fice   =  1   ! ice fraction sent to the atmosphere
@@ -157 +158 @@
    INTEGER, PARAMETER ::   jps_sstfrz = 37   ! sea surface freezing temperature
    INTEGER, PARAMETER ::   jps_ttilyr = 38   ! sea ice top layer temp
-
-   INTEGER, PARAMETER ::   jpsnd      = 38   ! total number of fields sent 
+   INTEGER, PARAMETER ::   jps_dummy_t = 39  ! Dummy test outgoing coupling tracer grid field
+
+   INTEGER, PARAMETER ::   jpsnd      = 39   ! total number of fields sent 
 
    !                                  !!** namelist namsbc_cpl **
@@ -278 +280 @@
          WRITE(numout,*)'~~~~~~~~~~~~'
       ENDIF
-      IF( lwp .AND. ln_cpl ) THEN                        ! control print
+      IF( lwp .AND. (ln_cpl .OR. ln_couple_test) ) THEN                        ! control print
          WRITE(numout,*)'  received fields (mutiple ice categogies)'
          WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')'
@@ -723 +725 @@
          ENDIF
       ENDIF
-      
+
+
+      IF (ln_couple_test) THEN
+         ! If we're just running a test coupled job then set all 
+         ! actions to false for all fields apart from our test field(s)
+         srcv(:)%laction = .FALSE.
+
+
+         srcv(jpr_dummy_t)%clname = 'R_OC_DUMMY_T'   
+         srcv(jpr_dummy_t)%laction = .TRUE.
+      ENDIF
+
       ! =================================================== !
       ! Allocate all parts of frcv used for received fields !
@@ -742 +755 @@
          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) )
       END IF
+
+
+
+
 
       ! ================================ !
@@ -1031 +1048 @@
       ENDIF
 
+      IF (ln_couple_test) THEN
+         ! If we're just running a test coupled job then set all 
+         ! actions to false for all fields apart from our test field(s)
+         ssnd(:)%laction = .FALSE.
+
+
+         ssnd(jps_dummy_t)%clname = 'S_OC_DUMMY_T'   
+         ssnd(jps_dummy_t)%laction = .TRUE.
+      ENDIF
+
+
       !
       ! ================================ !
@@ -1037 +1065 @@
 
       ! If ln_cpl is false, clearly we don't want to call cpl_dfine!
-      if (ln_cpl) CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
-      
+      IF (ln_cpl .OR. ln_couple_test) THEN
+           write(numout,*) "RSRH call cpl_define", ln_cpl ,ln_couple_test ; flush(numout)
+         CALL cpl_define(jprcv, jpsnd, nn_cplmodel)
+
+      ENDIF      
+           write(numout,*) "RSRH after cpl_define", ln_cpl ,ln_couple_test ; flush(numout)
+
+
       IF (ln_usecplmask) THEN 
          xcplmask(:,:,:) = 0.
@@ -1127 +1161 @@
       !                                                      ! ======================================================= !
       isec = ( kt - nit000 ) * NINT( rdt )                      ! date of exchanges
+
+
+      WRITE(numout,*) "RSRH in sbc_cpl_rcv" ; flush(numout)
+
       DO jn = 1, jprcv                                          ! received fields sent by the atmosphere
-         IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
+
+        WRITE(numout,*) "RSRH in sbc_cpl_rcv for field" ,jn, srcv(jn)%laction ;flush(numout)
+
+         IF( srcv(jn)%laction ) THEN
+        WRITE(numout,*) "RSRH call cpl_rcv for field", jn, srcv(jn)%laction ;flush(numout)
+               CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) )
+        WRITE(numout,*) "RSRH  done cpl_rcv for field", jn, srcv(jn)%laction, nrcvinfo(jn) ;flush(numout)
+         ENDIF
       END DO
 
+      WRITE(numout,*) "RSRH in sbc_cpl_rcv after all gets" ; flush(numout)
       !                                                      ! ========================= !
       IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  !
@@ -2595 +2641 @@
       IF( ssnd(jps_sstfrz)%laction )  CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
 #endif
+
+      WRITE(numout,*) "RSRH at send for ocean dummy_t"; flush(numout)
+
+      IF ( ssnd(jps_dummy_t)%laction ) THEN
+         ! RSRH Just set up some arbitrary test pattern for now
+         ztmp1(:,:) = 1.23456
+      WRITE(numout,*) "RSRH call send for ocean dummy_t"; flush(numout)
+         CALL cpl_snd( jps_dummy_t, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
+      WRITE(numout,*) "RSRH done send for ocean dummy_t", info; flush(numout)
+      ENDIF
+
       !
    END SUBROUTINE sbc_cpl_snd