Ignore:
Timestamp:
2015-05-20T18:20:59+02:00 (6 years ago)
Author:
dancopsey
Message:

First attempt to convert OASIS3-MCT branch from NEMO3.5 to NEMO3.6. Original branch was dev/frrh/vn3.5_beta_hadgem3_mct

File:
1 edited

Legend:

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

    r5279 r5284  
    2323   !!   cpl_finalize : finalize the coupled mode communication 
    2424   !!---------------------------------------------------------------------- 
    25 #if defined key_oasis3 
     25#if defined key_oasis3 || defined key_oasis3mct 
    2626   USE mod_oasis                    ! OASIS3-MCT module 
    2727#endif 
     
    3030   USE in_out_manager               ! I/O manager 
    3131   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
     32    
     33#if defined key_cpl_rootexchg 
     34   USE lib_mpp, only : mppsync 
     35   USE lib_mpp, only : mppscatter,mppgather 
     36#endif  
    3237 
    3338   IMPLICIT NONE 
     
    4045   PUBLIC   cpl_freq 
    4146   PUBLIC   cpl_finalize 
     47#if defined key_mpp_mpi 
     48   INCLUDE 'mpif.h' 
     49#endif 
     50    
     51   INTEGER, PARAMETER         :: localRoot  = 0 
     52   LOGICAL                    :: commRank            ! true for ranks doing OASIS communication 
     53#if defined key_cpl_rootexchg 
     54   LOGICAL                    :: rootexchg =.true.   ! logical switch  
     55#else 
     56   LOGICAL                    :: rootexchg =.false.  ! logical switch  
     57#endif  
    4258 
    4359   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     
    7894 
    7995   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    80  
     96   REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   tbuf  ! Temporary buffer for sending / receiving  
     97   INTEGER, PUBLIC :: localComm  
     98       
    8199   !!---------------------------------------------------------------------- 
    82100   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    104122      ! 1st Initialize the OASIS system for the application 
    105123      !------------------------------------------------------------------ 
    106       CALL oasis_init_comp ( ncomp_id, 'oceanx', nerror ) 
     124      CALL oasis_init_comp ( ncomp_id, 'toyoce', nerror ) 
    107125      IF ( nerror /= OASIS_Ok ) & 
    108126         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
     
    115133      IF ( nerror /= OASIS_Ok ) & 
    116134         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     135      localComm = kl_comm  
    117136      ! 
    118137   END SUBROUTINE cpl_init 
     
    143162      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 
    144163      IF(lwp) WRITE(numout,*) 
     164       
     165      commRank = .false. 
     166      IF ( rootexchg ) THEN 
     167         IF ( nproc == localRoot ) commRank = .true. 
     168      ELSE 
     169         commRank = .true. 
     170      ENDIF 
    145171 
    146172      IF( kcplmodel > nmaxcpl ) THEN 
     
    155181      ishape(:,2) = (/ 1, nlej-nldj+1 /) 
    156182      ! 
    157       ! ... Allocate memory for data exchange 
    158       ! 
    159       ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
    160       IF( nerror > 0 ) THEN 
    161          CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    162       ENDIF 
    163183      ! 
    164184      ! ----------------------------------------------------------------- 
    165185      ! ... Define the partition  
    166186      ! ----------------------------------------------------------------- 
     187       
     188      IF ( rootexchg ) THEN 
     189      
     190      paral(1) = 2              ! box partitioning 
     191      paral(2) = 0              ! NEMO lower left corner global offset      
     192      paral(3) = jpiglo         ! local extent in i  
     193      paral(4) = jpjglo         ! local extent in j 
     194      paral(5) = jpiglo         ! global extent in x 
     195 
     196      ELSE  
    167197       
    168198      paral(1) = 2                                              ! box partitioning 
     
    179209      ENDIF 
    180210       
    181       CALL oasis_def_partition ( id_part, paral, nerror ) 
     211      ENDIF 
     212      IF ( commRank )  CALL oasis_def_partition ( id_part, paral, nerror ) 
     213      
     214      ! ... Allocate memory for data exchange 
     215      ! 
     216      ALLOCATE(exfld(paral(3), paral(4)), stat = nerror) 
     217      IF( nerror > 0 ) THEN 
     218         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
     219      ENDIF 
     220      IF ( rootexchg ) THEN 
     221! Should possibly use one of the work arrays for tbuf really 
     222         ALLOCATE(tbuf(jpi, jpj, jpnij), stat = nerror) 
     223         IF( nerror > 0 ) THEN 
     224             CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating tbuf') ; RETURN 
     225         ENDIF 
     226       ENDIF              
     227       ! 
     228       IF (commRank ) THEN 
    182229      ! 
    183230      ! ... Announce send variables.  
     
    224271            END DO 
    225272         ENDIF 
    226       END DO 
     273      END DO       
    227274      ! 
    228275      ! ... Announce received variables.  
     
    271318         ENDIF 
    272319      END DO 
     320      ! 
     321      ENDIF  ! commRank=true  
    273322       
    274323      !------------------------------------------------------------------ 
     
    276325      !------------------------------------------------------------------ 
    277326       
    278       CALL oasis_enddef(nerror) 
    279       IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
     327      IF ( commRank ) THEN      
     328       
     329         CALL oasis_enddef(nerror) 
     330         IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
     331      ENDIF 
    280332      ! 
    281333   END SUBROUTINE cpl_define 
     
    294346      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdata 
    295347      !! 
    296       INTEGER                                   ::   jc,jm     ! local loop index 
     348      INTEGER                                   ::   jn,jc,jm     ! local loop index 
    297349      !!-------------------------------------------------------------------- 
    298350      ! 
     
    303355         
    304356            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
    305                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     357               IF ( rootexchg ) THEN 
     358                  ! 
     359                  ! collect data on the local root process 
     360                  ! 
     361                  CALL mppgather (pdata(:,:,jc),localRoot,tbuf)  
     362                  CALL mppsync  
     363            
     364                  IF ( nproc == localRoot ) THEN 
     365                                
     366                     DO jn = 1, jpnij 
     367                        exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1)= & 
     368                          tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn) 
     369                     ENDDO 
     370                
     371                     ! snd data to OASIS3 
     372                     CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, exfld, kinfo ) 
     373            
     374                  ENDIF 
     375            
     376               ELSE 
     377 
     378                   ! snd data to OASIS3 
     379                   CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     380               ENDIF 
    306381                
    307382               IF ( ln_ctl ) THEN         
     
    341416      INTEGER                   , INTENT(  out) ::   kinfo     ! OASIS3 info argument 
    342417      !! 
    343       INTEGER                                   ::   jc,jm     ! local loop index 
     418      INTEGER                                   ::   jn,jc,jm     ! local loop index 
    344419      LOGICAL                                   ::   llaction, llfisrt 
    345420      !!-------------------------------------------------------------------- 
     
    355430 
    356431            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    357  
    358                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     432                
     433               ! 
     434               ! receive data from OASIS3 
     435               ! 
     436               IF ( commRank )  CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 
     437        
     438               IF ( rootexchg )  CALL MPI_BCAST ( kinfo, 1, MPI_INTEGER, localRoot, localComm, nerror )                       
    359439                
    360440               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     
    367447                  kinfo = OASIS_Rcv 
    368448                  IF( llfisrt ) THEN  
    369                      pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     449                      
     450                     IF ( rootexchg ) THEN 
     451            
     452                        ! distribute data to processes 
     453                        ! 
     454                        IF ( nproc == localRoot ) THEN 
     455 
     456                           DO jn = 1, jpnij 
     457                              tbuf(nldit(jn):nleit(jn),nldjt(jn):nlejt(jn),jn)=          & 
     458                              exfld(nimppt(jn)-1+nldit(jn):nimppt(jn)+nleit(jn)-1,njmppt(jn)-1+nldjt(jn):njmppt(jn)+nlejt(jn)-1) 
     459                              ! NOTE: we are missing combining this with pmask (see else below) 
     460                           ENDDO 
     461                
     462                        ENDIF 
     463 
     464                        CALL mppscatter (tbuf,localRoot,pdata(:,:,jc))  
     465                        CALL mppsync 
     466 
     467                     ELSE 
     468            
     469                        pdata(nldi:nlei, nldj:nlej, jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     470                
     471                     ENDIF 
     472                      
    370473                     llfisrt = .FALSE. 
    371474                  ELSE 
     
    411514      INTEGER, DIMENSION(1) :: itmp 
    412515      !!---------------------------------------------------------------------- 
     516#if defined key_oasis3  
    413517      CALL oasis_get_freqs(kid, 1, itmp, info) 
    414518      cpl_freq = itmp(1) 
     519#endif 
     520 
     521#if defined key_oasis3mct 
     522      cpl_freq = namflddti( kid ) 
     523#endif 
    415524      ! 
    416525   END FUNCTION cpl_freq 
     
    427536      ! 
    428537      DEALLOCATE( exfld ) 
     538      IF ( rootexchg ) DEALLOCATE ( tbuf ) 
    429539      IF (nstop == 0) THEN 
    430540         CALL oasis_terminate( nerror )          
Note: See TracChangeset for help on using the changeset viewer.