Changeset 10041


Ignore:
Timestamp:
2018-08-07T12:17:06+02:00 (2 years ago)
Author:
dancopsey
Message:

Added coupling of 1D river outflow.

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

    r9279 r10041  
    2828#endif 
    2929   USE par_oce                      ! ocean parameters 
     30   USE cpl_rnf_1d, ONLY: nn_cpl_river   ! Variables used in 1D river outflow 
    3031   USE dom_oce                      ! ocean space and time domain 
    3132   USE in_out_manager               ! I/O manager 
     
    153154      INTEGER :: id_part 
    154155      INTEGER :: id_part_0d     ! Partition for 0d fields 
     156      INTEGER :: id_part_rnf_1d ! Partition for 1d river outflow fields 
     157      INTEGER :: id_part_temp   ! Temperary partition used to choose either 0d or 1d partitions 
     158      INTEGER :: vector_length  ! Length of 0d or 1d variables (0d variables will have vector_length=1) 
    155159      INTEGER :: paral(5)       ! OASIS3 box partition 
    156160      INTEGER :: ishape(2,2)    ! shape of arrays passed to PSMILe 
     
    228232      CALL oasis_def_partition ( id_part_0d, paral, nerror, 1 ) 
    229233 
    230  
    231  
     234      ! Another partition is needed for 1D river routing fields 
     235       
     236      paral(1) = 0                                       ! serial partitioning 
     237      paral(2) = 0    
     238      IF ( nproc == 0) THEN 
     239         paral(3) = nn_cpl_river                   ! Size of array to couple (vector) 
     240      ELSE 
     241         paral(3) = 0                   ! Dummy size for PE's not involved 
     242      END IF 
     243      paral(4) = 0 
     244      paral(5) = 0 
     245 
     246 
     247      CALL oasis_def_partition ( id_part_rnf_1d, paral, nerror, nn_cpl_river ) 
     248  
    232249      ! 
    233250      ! ... Announce send variables.  
     
    310327flush(numout) 
    311328 
    312                   ! If it's Greenland or Antarctic ice mass then define a 0D field 
    313                   IF (srcv(ji)%dimensions == 0) THEN 
    314 WRITE(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 ) 
     329                  ! Define 0D (Greenland or Antarctic ice mass) or 1D (river outflow) coupling fields 
     330                  IF (srcv(ji)%dimensions <= 1) THEN 
     331WRITE(numout,*) "RSRH 0d or 1d define field ",zclname; flush(numout) 
     332                    IF (nproc == 0) THEN                     
     333                        
     334                       IF (srcv(ji)%dimensions == 0) THEN 
     335                        
     336                          ! If 0D then set temporary variables to 0D components 
     337                          id_part_temp = id_part_0d 
     338                          vector_length = 1 
     339                       ELSE 
     340                        
     341                          ! If 1D then set temporary variables to river outflow components 
     342                          id_part_temp = id_part_rnf_1d 
     343                          vector_length = nn_cpl_river 
     344                           
     345                       END IF 
     346                        
     347                       CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part_temp   , (/ 1, 0 /),   & 
     348                                   OASIS_In           , (/ 1, vector_length /) , OASIS_REAL, nerror ) 
    319349                    ELSE 
    320350                       ! Dummy call to keep OASIS3-MCT happy.  
     
    428458            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    429459 
    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 )    
     460               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )    
    437461                
    438                  llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
    439                   &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
     462               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     463                &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    440464                
    441                  IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     465               IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    442466                
    443                  IF ( llaction ) THEN 
     467               IF ( llaction ) THEN 
    444468                   
    445469                  kinfo = OASIS_Rcv 
     
    462486                     WRITE(numout,*) '****************' 
    463487                  ENDIF 
    464                    
    465                  ENDIF 
    466               ENDIF    
     488 
     489               ENDIF 
     490 
    467491            ENDIF 
    468492             
     
    482506      !! 
    483507      !! ** Purpose : - A special version of cpl_rcv to deal exclusively with 
    484       !! receipt of 0D fields.  
     508      !! receipt of 0D or 1D fields.  
    485509      !! The fields are recieved into a 1D array buffer which is simply a  
    486510      !! dynamically sized sized array (which may be of size 1) 
     
    504528      INTEGER  ::   ierr 
    505529      LOGICAL  ::   llaction 
     530      INTEGER  ::   MPI_WORKING_PRECISION 
     531      INTEGER  ::   number_to_print  
    506532      !!-------------------------------------------------------------------- 
    507533      ! 
     
    510536      kinfo = OASIS_idle 
    511537      ! 
    512       ! 0D fields won't have categories or any other form of "pseudo level"  
     538      ! 0D and 1D fields won't have categories or any other form of "pseudo level"  
    513539      ! so we only cater for a single set of values and thus don't bother  
    514540      ! with a loop over the jc index  
     
    519545         IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    520546 
    521             IF ( ( srcv(kid)%dimensions == 0) .AND. (nproc == 0) ) THEN 
     547            IF ( ( srcv(kid)%dimensions <= 1) .AND. (nproc == 0) ) THEN 
    522548               ! Since there is no concept of data decomposition for zero  
    523549               ! dimension fields, they must only be exchanged through the master PE,  
     
    538564                   
    539565                  IF ( ln_ctl ) THEN         
     566                     number_to_print = 10 
     567                     IF ( nitems < number_to_print ) number_to_print = nitems 
    540568                     WRITE(numout,*) '****************' 
    541569                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
     
    545573                     WRITE(numout,*) '     - Minimum Value is ', MINVAL(pdata(:)) 
    546574                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(:)) 
     575                     WRITE(numout,*) '     - Start of data is ', pdata(1:number_to_print) 
    547576                     WRITE(numout,*) '****************' 
    548577                  ENDIF 
     
    553582             
    554583       ENDDO 
     584        
     585       ! Set the precision that we want to broadcast using MPI_BCAST 
     586       SELECT CASE( wp ) 
     587       CASE( sp )  
     588         MPI_WORKING_PRECISION = MPI_REAL                ! Single precision 
     589       CASE( dp ) 
     590         MPI_WORKING_PRECISION = MPI_DOUBLE_PRECISION    ! Double precision 
     591       CASE default 
     592         CALL oasis_abort( ncomp_id, "cpl_rcv_1d", "Could not find precision for coupling 0d or 1d field" ) 
     593       END SELECT 
    555594 
    556595       ! We have to broadcast (potentially) received values from PE 0 to all  
     
    559598       ! to deal with that w/o NEMO adopting a UM-style test mechanism 
    560599       ! to determine active put/get timesteps.  
    561        CALL mpi_bcast( pdata, nitems, MPI_Real, localRoot, mpi_comm_opa, ierr ) 
     600       CALL mpi_bcast( pdata, nitems, MPI_WORKING_PRECISION, localRoot, mpi_comm_opa, ierr ) 
    562601 
    563602      ! 
  • branches/UKMO/dev_r5518_cleanup_1d_cpl/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r9280 r10041  
    4646   USE eosbn2 
    4747   USE sbcrnf   , ONLY : l_rnfcpl 
     48   USE cpl_rnf_1d, ONLY: nn_cpl_river, cpl_rnf_1d_init, cpl_rnf_1d_to_2d   ! Variables used in 1D river outflow 
    4849#if defined key_cpl_carbon_cycle 
    4950   USE p4zflx, ONLY : oce_co2 
     
    111112   INTEGER, PARAMETER ::   jpr_atm_pco2 = 46          ! Incoming atm CO2 flux 
    112113   INTEGER, PARAMETER ::   jpr_atm_dust = 47          ! Incoming atm aggregate dust  
    113    INTEGER, PARAMETER ::   jprcv      = 47            ! total number of fields received 
     114   INTEGER, PARAMETER ::   jpr_rnf_1d = 48          ! Incoming atm aggregate dust  
     115   INTEGER, PARAMETER ::   jprcv      = 48            ! total number of fields received 
    114116 
    115117   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
     
    175177   LOGICAL     ::   ln_usecplmask          !  use a coupling mask file to merge data received from several models 
    176178                                           !   -> file cplmask.nc with the float variable called cplmask (jpi,jpj,nn_cplmodel) 
    177    INTEGER     ::   nn_cpl_river           ! Number of rivers to be dealt with in atmos-ocean coupling.  
    178179 
    179180   TYPE ::   DYNARR      
     
    468469      !                                                      ! ------------------------- ! 
    469470      srcv(jpr_rnf   )%clname = 'O_Runoff' 
    470       IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) THEN 
    471          srcv(jpr_rnf)%laction = .TRUE. 
     471      srcv(jpr_rnf_1d   )%clname = 'runoffo' 
     472      IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' .OR. TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN  
     473         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled' ) srcv(jpr_rnf)%laction = .TRUE. 
     474         IF( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) THEN 
     475            srcv(jpr_rnf_1d)%laction = .TRUE. 
     476            srcv(jpr_rnf_1d)%dimensions = 1 ! 1D field passed through coupler 
     477         END IF 
    472478         l_rnfcpl              = .TRUE.                      ! -> no need to read runoffs in sbcrnf 
    473479         ln_rnf                = nn_components /= jp_iam_sas ! -> force to go through sbcrnf if not sas 
     
    673679         ENDIF 
    674680      ENDIF 
    675        
    676       ! =================================================== ! 
    677       ! Allocate all parts of frcv used for received fields ! 
    678       ! =================================================== ! 
    679       DO jn = 1, jprcv 
    680  
    681          IF ( srcv(jn)%laction ) THEN  
    682             IF ( srcv(jn)%dimensions == 0 ) THEN 
    683 WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 
    684  
    685                ! We have a scalar field 
    686                ALLOCATE( frcv(jn)%z3(1,1,1) ) 
    687             ELSE 
    688  WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 
    689               ! We have a "normal" 2D (or pseudo 3D) field. 
    690                ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    691             END IF 
    692          END IF 
    693  
    694       END DO 
    695       ! Allocate taum part of frcv which is used even when not received as coupling field 
    696       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    697       ! Allocate w10m part of frcv which is used even when not received as coupling field 
    698       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    699       ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    700       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    701       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    702       ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    703       IF( k_ice /= 0 ) THEN 
    704          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    705          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    706       END IF 
    707681 
    708682      ! ================================ ! 
     
    971945         ENDIF 
    972946      ENDIF 
     947       
     948      ! Initialise 1D river outflow scheme  
     949      nn_cpl_river = 1  
     950      IF ( TRIM( sn_rcv_rnf%cldes ) == 'coupled1d' ) CALL cpl_rnf_1d_init   ! Coupled runoff using 1D array 
     951 
     952      ! =================================================== ! 
     953      ! Allocate all parts of frcv used for received fields ! 
     954      ! =================================================== ! 
     955      DO jn = 1, jprcv 
     956 
     957         IF ( srcv(jn)%laction ) THEN  
     958            SELECT CASE( srcv(jn)%dimensions ) 
     959            ! 
     960            CASE( 0 )   ! Scalar field 
     961WRITE(numout,*) "RSRH allocate zero dim field z3",jn ; flush(numout) 
     962 
     963               ! We have a scalar field 
     964               ALLOCATE( frcv(jn)%z3(1,1,1) ) 
     965                
     966            CASE( 1 )   ! 1D field 
     967             
     968               ! In the special case of 1D fields we can't allocate the array yet as 
     969               ! we don't know what nn_cpl_river is.  
     970WRITE(numout,*) "RSRH allocate 1 dim field z3",jn, nn_cpl_river ; flush(numout) 
     971                
     972               ALLOCATE( frcv(jn)%z3(nn_cpl_river,1,1) ) 
     973                
     974            CASE DEFAULT 
     975             
     976 WRITE(numout,*) "RSRH allocate 2 dim field z3",jn,srcv(jn)%nct ; flush(numout) 
     977              ! We have a "normal" 2D (or pseudo 3D) field. 
     978               ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     979            END SELECT 
     980         END IF 
     981 
     982      END DO 
     983      ! Allocate taum part of frcv which is used even when not received as coupling field 
     984      IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     985      ! Allocate w10m part of frcv which is used even when not received as coupling field 
     986      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     987      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     988      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     989      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     990      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
     991      IF( k_ice /= 0 ) THEN 
     992         IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     993         IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     994      END IF 
    973995 
    974996      ! 
     
    11071129 
    11081130            IF ( srcv(jn)%dimensions == 0 ) THEN 
    1109 write(numout,*) "RSRH recieving 0d field",kt,jn ; flush(numout) 
     1131write(numout,*) "RSRH recieving 0d or 1d field",kt,jn ; flush(numout) 
    11101132               CALL cpl_rcv_1d( jn, isec, frcv(jn)%z3, SIZE(frcv(jn)%z3), nrcvinfo(jn) ) 
    11111133            ELSE 
     
    14251447write(numout,*) "RSRH still in cpl_rcv inside teswt for grnm",kt ; flush(numout) 
    14261448 
    1427          zgreenland_icesheet_mass_in = zgreenland_icesheet_mass_in / zmask_sum 
    14281449         greenland_icesheet_timelapsed = greenland_icesheet_timelapsed + rdt          
    14291450 
     
    14601481         zantarctica_icesheet_mass_in = frcv(jpr_antm)%z3(1,1,1) 
    14611482 
    1462          zantarctica_icesheet_mass_in = zantarctica_icesheet_mass_in / zmask_sum 
    14631483         antarctica_icesheet_timelapsed = antarctica_icesheet_timelapsed + rdt          
    14641484 
     
    18611881      ! --- runoffs (included in emp later on) --- ! 
    18621882      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1883      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    18631884 
    18641885      ! --- calving (put in emp_tot and emp_oce) --- ! 
     
    18981919      ! runoffs and calving (put in emp_tot) 
    18991920      IF( srcv(jpr_rnf)%laction )   rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 
     1921      IF( srcv(jpr_rnf_1d)%laction )   CALL cpl_rnf_1d_to_2d(frcv(jpr_rnf_1d)%z3(:,:,:)) 
    19001922      IF( iom_use('hflx_rnf_cea') )   & 
    19011923         CALL iom_put( 'hflx_rnf_cea' , rnf(:,:) * zcptn(:,:) ) 
Note: See TracChangeset for help on using the changeset viewer.