Changeset 8731


Ignore:
Timestamp:
2017-11-17T12:37:29+01:00 (3 years ago)
Author:
dancopsey
Message:

Merged in NEMO3.6 version of this branch (dev_r5518_GC3_couple_pkg)

Location:
branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r8730 r8731  
    10701070      ENDIF 
    10711071#endif 
     1072 
     1073      IF (cdfile_name == "output.abort") THEN 
     1074         CALL ctl_stop('STOP', 'NEMO abort from dia_wri_state') 
     1075      END IF 
     1076        
    10721077      !  
    10731078   END SUBROUTINE dia_wri_state 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r8730 r8731  
    24062406 
    24072407   SUBROUTINE mppstop 
     2408    
     2409   USE mod_oasis      ! coupling routines 
     2410 
    24082411      !!---------------------------------------------------------------------- 
    24092412      !!                  ***  routine mppstop  *** 
     
    24152418      !!---------------------------------------------------------------------- 
    24162419      ! 
     2420       
     2421#if defined key_oasis3 
     2422      ! If we're trying to shut down cleanly then we need to consider the fact 
     2423      ! that this could be part of an MPMD configuration - we don't want to 
     2424      ! leave other components deadlocked. 
     2425 
     2426      CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 
     2427 
     2428 
     2429#else 
     2430       
    24172431      CALL mppsync 
    24182432      CALL mpi_finalize( info ) 
     2433#endif 
     2434 
    24192435      ! 
    24202436   END SUBROUTINE mppstop 
     
    43334349         ENDIF 
    43344350         CALL FLUSH(kout)  
    4335          STOP 'ctl_opn bad opening' 
     4351         CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 
    43364352      ENDIF 
    43374353      ! 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r8730 r8731  
    4242   PUBLIC   cpl_freq 
    4343   PUBLIC   cpl_finalize 
     44#if defined key_mpp_mpi 
     45   INCLUDE 'mpif.h' 
     46#endif 
     47    
     48   INTEGER, PARAMETER         :: localRoot  = 0 
     49   LOGICAL                    :: commRank            ! true for ranks doing OASIS communication 
     50#if defined key_cpl_rootexchg 
     51   LOGICAL                    :: rootexchg =.true.   ! logical switch  
     52#else 
     53   LOGICAL                    :: rootexchg =.false.  ! logical switch  
     54#endif  
    4455 
    4556   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     
    8394 
    8495   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    85  
     96   INTEGER, PUBLIC :: localComm  
     97       
    8698   !!---------------------------------------------------------------------- 
    8799   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    121133      IF ( nerror /= OASIS_Ok ) & 
    122134         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     135      localComm = kl_comm  
    123136      ! 
    124137   END SUBROUTINE cpl_init 
     
    373386            IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 
    374387 
    375                CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )          
     388               CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo )    
    376389                
    377390               llaction =  kinfo == OASIS_Recvd   .OR. kinfo == OASIS_FromRest .OR.   & 
     
    463476         CALL oasis_get_freqs(id, mop, 1, itmp, info) 
    464477#else 
    465          CALL oasis_get_freqs(id,      1, itmp, info) 
    466 #endif 
    467          cpl_freq = itmp(1) 
     478!         CALL oasis_get_freqs(id,      1, itmp, info) 
     479         cpl_freq = namflddti( id ) 
     480#endif 
    468481      ENDIF 
    469482      ! 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r8730 r8731  
    5151   !!---------------------------------------------------------------------- 
    5252CONTAINS 
     53 
     54   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
     55                       px2 , py2 , kchoix  ) 
     56      !!---------------------------------------------------------------------- 
     57      !!                  ***  ROUTINE repcmo  *** 
     58      !! 
     59      !! ** Purpose :   Change vector componantes from a geographic grid to a 
     60      !!      stretched coordinates grid. 
     61      !! 
     62      !! ** Method  :   Initialization of arrays at the first call. 
     63      !! 
     64      !! ** Action  : - px2 : first  componante (defined at u point) 
     65      !!              - py2 : second componante (defined at v point) 
     66      !!---------------------------------------------------------------------- 
     67      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxu1, pyu1   ! geographic vector componantes at u-point 
     68      REAL(wp), INTENT(in   ), DIMENSION(jpi,jpj) ::   pxv1, pyv1   ! geographic vector componantes at v-point 
     69      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   px2          ! i-componante (defined at u-point) 
     70      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
     71      !!---------------------------------------------------------------------- 
     72      INTEGER, INTENT( IN ) ::   & 
     73         kchoix   ! type of transformation 
     74                  ! = 1 change from geographic to model grid. 
     75                  ! =-1 change from model to geographic grid 
     76      !!---------------------------------------------------------------------- 
     77  
     78      SELECT CASE (kchoix) 
     79      CASE ( 1) 
     80        ! Change from geographic to stretched coordinate 
     81        ! ---------------------------------------------- 
     82      
     83        CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
     84        CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
     85      CASE (-1) 
     86       ! Change from stretched to geographic coordinate 
     87       ! ---------------------------------------------- 
     88      
     89       CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 
     90       CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 
     91     END SELECT 
     92      
     93   END SUBROUTINE repcmo 
    5394 
    5495   SUBROUTINE rot_rep ( pxin, pyin, cd_type, cdtodo, prot ) 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8730 r8731  
    210210      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    211211#endif 
    212       ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     212      !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     213      ! Hardwire only two models as nn_cplmodel has not been read in 
     214      ! from the namelist yet. 
     215      ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) )    
    213216      ! 
    214217      IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) )  
     
    318321 
    319322      !                                   ! allocate sbccpl arrays 
    320       IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
     323      !IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    321324      
    322325      ! ================================ ! 
     
    382385         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    383386         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    384          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     387         !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     388! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 
     389         srcv(jpr_otx1)%laction = .TRUE.  
     390         srcv(jpr_oty1)%laction = .TRUE. 
     391! 
    385392         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    386393      CASE( 'T,I' )  
     
    984991      LOGICAL  ::   llnewtx, llnewtau      ! update wind stress components and module?? 
    985992      INTEGER  ::   ji, jj, jn             ! dummy loop indices 
    986       INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdt did not change since nit000) 
     993      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     994      INTEGER  ::   ikchoix 
    987995      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    988996      REAL(wp) ::   zcoef                  ! temporary scalar 
     
    990998      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    991999      REAL(wp) ::   zzx, zzy               ! temporary variables 
    992       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     1000      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    9931001      !!---------------------------------------------------------------------- 
    9941002      ! 
    9951003      IF( nn_timing == 1 )   CALL timing_start('sbc_cpl_rcv') 
    9961004      ! 
    997       CALL wrk_alloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1005      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    9981006      ! 
    9991007      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    10331041            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    10341042               !                                                       ! (geographical to local grid -> rotate the components) 
    1035                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    1036                IF( srcv(jpr_otx2)%laction ) THEN 
    1037                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    1038                ELSE 
    1039                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     1043               IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 
     1044                  ! Temporary code for HadGEM3 - will be removed eventually. 
     1045        ! Only applies when we have only taux on U grid and tauy on V grid 
     1046             DO jj=2,jpjm1 
     1047                DO ji=2,jpim1 
     1048                     ztx(ji,jj)=0.25*vmask(ji,jj,1)                & 
     1049                        *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1)    & 
     1050                        +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 
     1051                     zty(ji,jj)=0.25*umask(ji,jj,1)                & 
     1052                        *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1)    & 
     1053                        +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 
     1054                ENDDO 
     1055             ENDDO 
     1056                    
     1057             ikchoix = 1 
     1058             CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 
     1059             CALL lbc_lnk (ztx2,'U', -1. ) 
     1060             CALL lbc_lnk (zty2,'V', -1. ) 
     1061             frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 
     1062             frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 
     1063          ELSE 
     1064             CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     1065             frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     1066             IF( srcv(jpr_otx2)%laction ) THEN 
     1067                CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     1068             ELSE 
     1069                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
     1070             ENDIF 
     1071          frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid   
    10401072               ENDIF 
    1041                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    1042                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    10431073            ENDIF 
    10441074            !                               
     
    13111341      ENDIF 
    13121342      ! 
    1313       CALL wrk_dealloc( jpi,jpj,   ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1343      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    13141344      ! 
    13151345      IF( nn_timing == 1 )   CALL timing_stop('sbc_cpl_rcv') 
     
    19782008      ! 
    19792009      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     2010      INTEGER ::   ikchoix 
    19802011      INTEGER ::   isec, info   ! local integer 
    19812012      REAL(wp) ::   zumax, zvmax 
     
    21562187         !                                                  j+1   j     -----V---F 
    21572188         ! surface velocity always sent from T point                     !       | 
    2158          !                                                        j      |   T   U 
     2189         ! [except for HadGEM3]                                   j      |   T   U 
    21592190         !                                                               |       | 
    21602191         !                                                   j    j-1   -I-------| 
     
    21682199            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    21692200            CASE( 'oce only'             )      ! C-grid ==> T 
    2170                DO jj = 2, jpjm1 
    2171                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    2172                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    2173                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2201               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2202                  DO jj = 2, jpjm1 
     2203                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     2204                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     2205                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2206                     END DO 
    21742207                  END DO 
    2175                END DO 
     2208               ELSE 
     2209! Temporarily Changed for UKV 
     2210                  DO jj = 2, jpjm1 
     2211                     DO ji = 2, jpim1 
     2212                        zotx1(ji,jj) = un(ji,jj,1) 
     2213                        zoty1(ji,jj) = vn(ji,jj,1) 
     2214                     END DO 
     2215                  END DO 
     2216               ENDIF  
    21762217            CASE( 'weighted oce and ice' )    
    21772218               SELECT CASE ( cp_ice_msh ) 
     
    22322273                  END DO 
    22332274               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    2234                   DO jj = 2, jpjm1 
    2235                      DO ji = 2, jpim1   ! NO vector opt. 
    2236                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    2237                            &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    2238                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    2239                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    2240                            &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    2241                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2275                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2276                     DO jj = 2, jpjm1 
     2277                        DO ji = 2, jpim1   ! NO vector opt. 
     2278                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
     2279                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     2280                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2281                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
     2282                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     2283                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2284                        END DO 
    22422285                     END DO 
    2243                   END DO 
     2286#if defined key_cice 
     2287                  ELSE 
     2288! Temporarily Changed for HadGEM3 
     2289                     DO jj = 2, jpjm1 
     2290                        DO ji = 2, jpim1   ! NO vector opt. 
     2291                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
     2292                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
     2293                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
     2294                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     2295                        END DO 
     2296                     END DO 
     2297#endif 
     2298                  ENDIF 
    22442299               END SELECT 
    22452300            END SELECT 
     
    22512306         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    22522307            !                                                                     ! Ocean component 
    2253             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    2254             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    2255             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    2256             zoty1(:,:) = ztmp2(:,:) 
    2257             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    2258                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    2259                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    2260                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    2261                zity1(:,:) = ztmp2(:,:) 
    2262             ENDIF 
     2308            IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2309               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2310               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2311               zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2312               zoty1(:,:) = ztmp2(:,:) 
     2313               IF( ssnd(jps_ivx1)%laction ) THEN                                  ! Ice component 
     2314                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2315                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2316                  zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2317                  zity1(:,:) = ztmp2(:,:) 
     2318               ENDIF 
     2319            ELSE 
     2320               ! Temporary code for HadGEM3 - will be removed eventually. 
     2321               ! Only applies when we want uvel on U grid and vvel on V grid 
     2322               ! Rotate U and V onto geographic grid before sending. 
     2323 
     2324               DO jj=2,jpjm1 
     2325                  DO ji=2,jpim1 
     2326                     ztmp1(ji,jj)=0.25*vmask(ji,jj,1)                  & 
     2327                          *(zotx1(ji,jj)+zotx1(ji-1,jj)    & 
     2328                          +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 
     2329                     ztmp2(ji,jj)=0.25*umask(ji,jj,1)                  & 
     2330                          *(zoty1(ji,jj)+zoty1(ji+1,jj)    & 
     2331                          +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 
     2332                  ENDDO 
     2333               ENDDO 
     2334                
     2335               ! Ensure any N fold and wrap columns are updated 
     2336               CALL lbc_lnk(ztmp1, 'V', -1.0) 
     2337               CALL lbc_lnk(ztmp2, 'U', -1.0) 
     2338                
     2339               ikchoix = -1 
     2340               CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 
     2341           ENDIF 
    22632342         ENDIF 
    22642343         ! 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r8730 r8731  
    286286      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    287287      ! 
     288      ! In coupled mode get extra fields from CICE for passing back to atmosphere 
     289  
     290      IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 
     291      !  
    288292      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
    289293      ! 
     
    708712      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_hadgam') 
    709713      ! 
    710       IF( kt == nit000 )  THEN 
    711          IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    712          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    713       ENDIF 
    714  
    715714      !                                         ! =========================== ! 
    716715      !                                         !   Prepare Coupling fields   ! 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r8730 r8731  
    290290      !                             !* OASIS initialization 
    291291      ! 
    292       IF( lk_oasis )   CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step 
    293       !                                              !                      (2) the use of nn_fsbc 
     292      IF( lk_oasis ) THEN 
     293         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )  
     294         CALL sbc_cpl_init( nn_ice )   ! Must be done before: (1) first time step 
     295                                       !                      (2) the use of nn_fsbc 
     296      ENDIF 
    294297      !     nn_fsbc initialization if OPA-SAS coupling via OASIS 
    295298      !     SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8730 r8731  
    9090   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
    9191   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     92   USE sbccpl  
    9293#if defined key_iomput 
    9394   USE xios           ! xIOserver 
     
    181182#else 
    182183            IF ( .NOT. ln_diurnal_only ) THEN  
     184               IF (lk_oasis) CALL sbc_cpl_snd( istp )  ! Coupling to atmos 
    183185               CALL stp( istp )                 ! standard time stepping  
     186               ! We don't couple on the final timestep because 
     187               ! our restart file has already been written 
     188               ! and contains all the necessary data for a 
     189               ! restart. sbc_cpl_snd could be called here 
     190               ! but it would require 
     191               ! a) A test to ensure it was not performed 
     192               !    on the very last time-step 
     193               ! b) the presence of another call to 
     194               !    sbc_cpl_snd call prior to the main DO loop 
     195               ! This solution produces identical results 
     196               ! with fewer lines of code.  
    184197            ELSE  
    185198               CALL stp_diurnal( istp )        ! time step only the diurnal SST  
     
    304317      IF( Agrif_Root() ) THEN 
    305318         IF( lk_oasis ) THEN 
    306             CALL cpl_init( "oceanx", ilocal_comm )                               ! nemo local communicator given by oasis 
     319            CALL cpl_init( "toyoce", ilocal_comm )                     ! nemo local communicator given by oasis 
    307320            CALL xios_initialize( "not used"       ,local_comm= ilocal_comm )    ! send nemo communicator to xios 
    308321         ELSE 
     
    315328      IF( lk_oasis ) THEN 
    316329         IF( Agrif_Root() ) THEN 
    317             CALL cpl_init( "oceanx", ilocal_comm )          ! nemo local communicator given by oasis 
     330            CALL cpl_init( "toyoce", ilocal_comm )                      ! nemo local communicator given by oasis 
    318331         ENDIF 
    319332         ! Nodes selection (control print return in cltxt) 
     
    516529                            CALL dia_tmb_init  ! TMB outputs 
    517530                            CALL dia_25h_init  ! 25h mean  outputs 
     531       
     532      IF (nstop > 0) THEN 
     533        CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 
     534      END IF 
     535 
    518536      ! 
    519537   END SUBROUTINE nemo_init 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/step.F90

    r8730 r8731  
    328328                         CALL ctl_stop( 'step: indic < 0' ) 
    329329                         CALL dia_wri_state( 'output.abort', kstp ) 
     330                               CALL ctl_stop('STOP','NEMO failure in stp') 
    330331      ENDIF 
    331332      IF( kstp == nit000 ) THEN 
     
    339340      ! Coupled mode 
    340341      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    341 !!gm why lk_oasis and not lk_cpl ???? 
    342       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     342      !IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    343343      ! 
    344344#if defined key_iomput 
  • branches/UKMO/dev_r8183_GC_couple_pkg/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r8730 r8731  
    453453   SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt ,   & 
    454454      &                      kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d    ) 
     455   USE in_out_manager, ONLY: numout 
    455456      INTEGER                              , INTENT(in   )           :: kidim, kjdim, kkdim, kldim 
    456457      INTEGER                              , INTENT(in   )           :: kisrt, kjsrt, kksrt, klsrt 
     
    483484         &      .AND. SUM( tree(ii)%ishape ) /= 0 ) 
    484485         ii = ii + 1 
    485          IF (ii > jparray) STOP   ! increase the value of jparray (should not be needed as already very big!) 
     486         IF (ii > jparray) THEN 
     487            WRITE(numout,*) "E R R O R: NEMO aborted wrk_allocbase" 
     488            FLUSH(numout) 
     489            STOP 'Increase the value of jparray' 
     490                           ! increase the value of jparray (should not be needed as already very big!) 
     491         END IF 
    486492      END DO 
    487493       
Note: See TracChangeset for help on using the changeset viewer.