Changeset 9218


Ignore:
Timestamp:
2018-01-12T16:22:43+01:00 (3 years ago)
Author:
frrh
Message:

First working version defining and receiveing 0D couping
fields on PE 0 and broadcasting values using MPI_BCAST.

Location:
branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r8280 r9218  
    3939   PUBLIC   cpl_snd 
    4040   PUBLIC   cpl_rcv 
     41   PUBLIC   cpl_rcv_1d 
    4142   PUBLIC   cpl_freq 
    4243   PUBLIC   cpl_finalize 
     
    8889      INTEGER               ::   nct       ! Number of categories in field 
    8990      INTEGER               ::   ncplmodel ! Maximum number of models to/from which this variable may be sent/received 
     91      INTEGER               ::   dimensions ! Number of dimensions of coupling field 
    9092   END TYPE FLD_CPL 
    9193 
     
    150152      ! 
    151153      INTEGER :: id_part 
     154      INTEGER :: id_part_0d     ! Partition for 0d fields 
    152155      INTEGER :: paral(5)       ! OASIS3 box partition 
    153156      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
     
    210213       
    211214      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 
     215 
     216      ! A special partition is needed for 0D fields 
     217      
     218      paral(1) = 0                                       ! serial partitioning 
     219      paral(2) = 0    
     220      IF ( nproc == 0) THEN 
     221         paral(3) = 1                   ! Size of array to couple (scalar) 
     222      ELSE 
     223         paral(3) = 0                   ! Dummy size for PE's not involved 
     224      END IF 
     225      paral(4) = 0 
     226      paral(5) = 0 
     227         
     228      CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 
     229 
     230 
     231 
    212232      ! 
    213233      ! ... Announce send variables.  
     
    288308#endif 
    289309                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    290                   CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
    291                      &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
     310flush(numout) 
     311 
     312                  ! If it's Greenland or Antarctic ice mass then define a 0D field 
     313                  IF (srcv(ji)%dimensions == 0) THEN 
     314WRITE(numout,*) "RSRH 0d define field ",zclname; flush(numout) 
     315                    ! Define 0D coupling fields 
     316                    IF (nproc == 0) THEN 
     317                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d   , (/ 1, 0 /),   & 
     318                                   OASIS_In           , (/ 1, 1 /) , OASIS_REAL, nerror ) 
     319                    ELSE 
     320                       ! Dummy call to keep OASIS3-MCT happy.  
     321                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_0d   , (/ 1, 0 /),   & 
     322                                   OASIS_In           , (/ 0, 0 /) , OASIS_REAL, nerror ) 
     323                    END IF 
     324WRITE(numout,*) "RSRH 0d field done ",zclname,nerror; flush(numout) 
     325                  ELSE  
     326WRITE(numout,*) "RSRH 2d define field ",zclname; flush(numout) 
     327                    ! It's a "normal" 2D (or pseudo 3D) coupling field.   
     328                    CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 0 /),   & 
     329                                         OASIS_In           , ishape , OASIS_REAL, nerror ) 
     330WRITE(numout,*) "RSRH 2d field done ",zclname,nerror; flush(numout) 
     331                  ENDIF 
     332 
    292333                  IF ( nerror /= OASIS_Ok ) THEN 
    293334                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
     
    305346      ! End of definition phase 
    306347      !------------------------------------------------------------------ 
    307        
     348 WRITE(numout,*) "RSRH NEMO calling enddef";flush(numout)       
    308349      CALL oasis_enddef(nerror) 
     350WRITE(numout,*) "RSRH NEMO finished enddef", nerror;flush(numout)       
    309351      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
    310352      ! 
     
    386428            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    387429 
    388                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )    
     430 
     431               IF (( srcv(kid)%dimensions /= 0) .OR. &  
     432                   (( srcv(kid)%dimensions == 0) .AND. nproc == 0)) THEN 
     433                 ! Zero dimension fields must only be exchanged through the master PE.  
     434                 ! In normal 2D cases, every PE is involved.  
     435 
     436                 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )    
    389437                
    390                llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     438                 llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    391439                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    392440                
    393                IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     441                 IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    394442                
    395                IF ( llaction ) THEN 
     443                 IF ( llaction ) THEN 
    396444                   
    397445                  kinfo = OASIS_Rcv 
     
    415463                  ENDIF 
    416464                   
    417                ENDIF 
    418                
     465                 ENDIF 
     466              ENDIF   
    419467            ENDIF 
    420468             
     
    428476      ! 
    429477   END SUBROUTINE cpl_rcv 
     478 
     479   SUBROUTINE cpl_rcv_1d( kid, kstep, pdata, items, kinfo ) 
     480      !!--------------------------------------------------------------------- 
     481      !!              ***  ROUTINE cpl_rcv_1d  *** 
     482      !! 
     483      !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 
     484      !! 1D fields. The one dimension in this sense does not represent any spatial 
     485      !! dimension, it merely represents an arbitrary number of single values 
     486      !! i.e. the fields recieved are simply an array (which may be of size 1) 
     487      !! of 0 dimensional fields.   
     488      !!---------------------------------------------------------------------- 
     489      INTEGER , INTENT(in   ) ::   items       ! variable index in the array 
     490      INTEGER , INTENT(in   ) ::   kid         ! variable index in the array 
     491      INTEGER , INTENT(in   ) ::   kstep       ! ocean time-step in seconds 
     492      REAL(wp), INTENT(inout) ::   pdata(1:items)    ! IN to keep the value if nothing is done 
     493      INTEGER , INTENT(  out) ::   kinfo       ! OASIS3 info argument 
     494      !!  
     495      REAL(wp) ::   recvfld(1:items)   ! Received field  
     496      INTEGER                                   ::   jc,jm     ! local loop index 
     497      INTEGER :: ierr 
     498      LOGICAL                                   ::   llaction, llfisrt 
     499      !!-------------------------------------------------------------------- 
     500      ! 
     501      ! receive local data from OASIS3 on every process 
     502      ! 
     503      kinfo = OASIS_idle 
     504      ! 
     505      jc = 1 
     506 
     507         DO jm = 1, srcv(kid)%ncplmodel 
     508 
     509            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
     510 
     511 
     512               IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN 
     513                 ! Zero dimension fields must only be exchanged through the master PE.  
     514                 ! In normal 2D cases, every PE is involved.  
     515 
     516                 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, recvfld, kinfo )    
     517                
     518                 llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     519                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     520                
     521                 IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     522                
     523                 IF ( llaction ) THEN 
     524                   
     525                  kinfo = OASIS_Rcv 
     526                  pdata(1:items) = recvfld(1:items)  
     527                   
     528                  IF ( ln_ctl ) THEN         
     529                     WRITE(numout,*) '****************' 
     530                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     531                     WRITE(numout,*) 'oasis_get: ivarid '  , srcv(kid)%nid(jc,jm) 
     532                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
     533                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
     534                     WRITE(numout,*) '     - Minimum Value is ', MINVAL(pdata(:)) 
     535                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:)) 
     536                     WRITE(numout,*) '****************' 
     537                  ENDIF 
     538                   
     539                 ENDIF 
     540              ENDIF    
     541            ENDIF 
     542             
     543         ENDDO 
     544write(numout,*) "RSRH call bcast for 0D size",items;flush(numout) 
     545 
     546         ! There are no halos to deal with but we do have to broadcast values from PE 0 to all the 
     547         ! others.  
     548         CALL mpi_bcast( pdata, items, MPI_Real, localRoot, mpi_comm_opa, ierr ) 
     549write(numout,*) "RSRH done bcast for 0D";flush(numout) 
     550 
     551      ! 
     552   END SUBROUTINE cpl_rcv_1d 
    430553 
    431554 
  • branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8427 r9218  
    339339 
    340340      ! default definitions of srcv 
    341       srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 
     341      srcv(:)%laction = .FALSE.   ;   srcv(:)%clgrid = 'T'   ;   srcv(:)%nsgn = 1.   ;   srcv(:)%nct = 1 ; srcv(:)%dimensions = 2 
    342342 
    343343      !                                                      ! ------------------------- ! 
     
    468468      ENDIF 
    469469      ! 
    470       srcv(jpr_cal   )%clname = 'OCalving'   ;   IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
    471       srcv(jpr_grnm  )%clname = 'OGrnmass'   ;   IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' )   srcv(jpr_grnm)%laction = .TRUE. 
    472       srcv(jpr_antm  )%clname = 'OAntmass'   ;   IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' )   srcv(jpr_antm)%laction = .TRUE. 
     470      srcv(jpr_cal   )%clname = 'OCalving'    
     471      IF( TRIM( sn_rcv_cal%cldes ) == 'coupled' )   srcv(jpr_cal)%laction = .TRUE. 
     472      srcv(jpr_grnm  )%clname = 'OGrnmass'    
     473      srcv(jpr_grnm  )%dimensions = 0 ! Scalar field    
     474write(numout,*) "RSRH set up grnmss dimension:" 
     475 
     476 
     477      IF( TRIM( sn_rcv_grnm%cldes ) == 'coupled' )   srcv(jpr_grnm)%laction = .TRUE. 
     478      srcv(jpr_antm  )%clname = 'OAntmass'    
     479      srcv(jpr_antm  )%dimensions = 0 ! Scalar field    
     480      IF( TRIM( sn_rcv_antm%cldes ) == 'coupled' )   srcv(jpr_antm)%laction = .TRUE. 
    473481 
    474482 
     
    662670      ! =================================================== ! 
    663671      DO jn = 1, jprcv 
    664          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     672 
     673         IF ( srcv(jn)%laction ) THEN  
     674            IF ( srcv(jn)%dimensions == 0 ) THEN 
     675WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 
     676 
     677               ! We have a scalar field 
     678               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     679            ELSE 
     680 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 
     681              ! We have a "normal" 2D (or pseudo 3D) field. 
     682               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     683            END IF 
     684         END IF 
     685 
    665686      END DO 
    666687      ! Allocate taum part of frcv which is used even when not received as coupling field 
     
    685706       
    686707      ! default definitions of nsnd 
    687       ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 
     708      ssnd(:)%laction = .FALSE.   ;   ssnd(:)%clgrid = 'T'   ;   ssnd(:)%nsgn = 1.  ; ssnd(:)%nct = 1 ; ssnd(:)%dimensions = 2 
    688709          
    689710      !                                                      ! ------------------------- ! 
     
    10671088      ! 
    10681089      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     1090write(numout,*) "RSRH in cpl_rcv",kt ; flush(numout) 
    10691091      ! 
    10701092      !                                                      ! ======================================================= ! 
     
    10731095      isec = ( kt - nit000 ) * NINT( rdttra(1) )                ! date of exchanges 
    10741096      DO jn = 1, jprcv                                          ! received fields sent by the atmosphere 
    1075          IF( srcv(jn)%laction )   CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1097         IF( srcv(jn)%laction ) THEN  
     1098write(numout,*) "RSRH recieving field via call to cpl_rcv",kt,jn ; flush(numout) 
     1099 
     1100            IF ( srcv(jn)%dimensions == 0 ) THEN 
     1101write(numout,*) "RSRH recieving 0d field",kt,jn ; flush(numout) 
     1102               CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 
     1103            ELSE 
     1104write(numout,*) "RSRH recieving 2d field",kt,jn ; flush(numout) 
     1105               CALL cpl_rcv( jn, isec, frcv(jn)%z3, xcplmask(:,:,1:nn_cplmodel), nrcvinfo(jn) ) 
     1106            END IF 
     1107write(numout,*) "RSRH completed recieve of field via call to cpl_rcv",kt,jn ; flush(numout) 
     1108 
     1109         END IF 
    10761110      END DO 
    1077  
     1111write(numout,*) "RSRH still in cpl_rcv",kt ; flush(numout) 
    10781112      !                                                      ! ========================= ! 
    10791113      IF( srcv(jpr_otx1)%laction ) THEN                      !  ocean stress components  ! 
     
    13761410         zmask_sum = glob_sum( tmask(:,:,1) ) 
    13771411      ENDIF 
     1412write(numout,*) "RSRH still in cpl_rcv at teswt for grnm",kt ; flush(numout) 
    13781413 
    13791414      IF( srcv(jpr_grnm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    1380          greenland_icesheet_mass_array(:,:) = frcv(jpr_grnm)%z3(:,:,1) 
    1381          ! take average over ocean points of input array to avoid cumulative error over time 
    1382          ! The following must be bit reproducible over different PE decompositions 
    1383          zgreenland_icesheet_mass_in = glob_sum( greenland_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
     1415         ! This is a zero dimensional, single value field.  
     1416         zgreenland_icesheet_mass_in =  frcv(jpr_grnm)%z3(1,1,1) 
     1417write(numout,*) "RSRH still in cpl_rcv inside teswt for grnm",kt ; flush(numout) 
    13841418 
    13851419         zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 
     
    14151449      !                                                        ! land ice masses : Antarctica 
    14161450      IF( srcv(jpr_antm)%laction .AND. nn_coupled_iceshelf_fluxes == 1 ) THEN 
    1417          antarctica_icesheet_mass_array(:,:) = frcv(jpr_antm)%z3(:,:,1) 
    1418          ! take average over ocean points of input array to avoid cumulative error from rounding errors over time 
    1419          ! The following must be bit reproducible over different PE decompositions 
    1420          zantarctica_icesheet_mass_in = glob_sum( antarctica_icesheet_mass_array(:,:) * tmask(:,:,1) ) 
     1451         ! This is a zero dimensional, single value field.  
     1452         zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 
    14211453 
    14221454         zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 
Note: See TracChangeset for help on using the changeset viewer.