Changeset 8200


Ignore:
Timestamp:
2017-06-21T14:27:02+02:00 (3 years ago)
Author:
frrh
Message:

Merge branches/UKMO/dev_r5518_GC3_couple_pkg@7985 using command:

svn merge -r 6574:7985 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/dev_r5518_GC3_couple_pkg

Location:
branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC
Files:
15 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90

    r6486 r8200  
    124124 
    125125    CASE DEFAULT 
    126        IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' 
    127        STOP 'dia_wri_dimg' 
     126     
     127       WRITE(numout,*) 'dia_wri_dimg : E R R O R : bad cd_type in dia_wri_dimg' 
     128       CALL ctl_stop( 'STOP', 'dia_wri_dimg :bad cd_type in dia_wri_dimg ' ) 
    128129 
    129130    END SELECT 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r7651 r8200  
    11161116      ENDIF 
    11171117#endif 
     1118 
     1119      IF (cdfile_name == "output.abort") THEN 
     1120         CALL ctl_stop('STOP', 'NEMO abort from dia_wri_state') 
     1121      END IF 
    11181122        
    11191123!     IF( nn_timing == 1 )   CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r6486 r8200  
    112112    IF( inbsel >  jpk ) THEN 
    113113       IF(lwp) WRITE(numout,*)  ' STOP inbsel =',inbsel,' is larger than jpk=',jpk 
    114        STOP 
     114       CALL ctl_stop('STOP', 'NEMO aborted from dia_wri') 
    115115    ENDIF 
    116116 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6491 r8200  
    550550      IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 
    551551      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   using Schchepetkin and O Brian scheme' 
    552       IF( lk_mpp )   CALL ctl_stop( ' mpp version is not yet implemented' ) 
     552      IF( lk_mpp )   CALL ctl_stop('STOP', ' mpp version is not yet implemented' ) 
    553553 
    554554      ! mask for second order calculation of vorticity 
     
    572572         WRITE(numout,*) ' symetric boundary conditions need special' 
    573573         WRITE(numout,*) ' treatment not implemented. we stop.' 
    574          STOP 
     574         CALL ctl_stop('STOP', 'NEMO abort from dom_msk_nsa') 
    575575      ENDIF 
    576576       
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r6486 r8200  
    465465            END DO 
    466466         ELSE 
    467             IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
    468             IF(lwp)WRITE(numout,*) '         We stop' 
    469             STOP 'ldfguv' 
     467             
     468            WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 
     469            WRITE(numout,*) '         We stop' 
     470            CALL ctl_stop('STOP', 'ldfguv: Unexpected kahm value') 
     471 
    470472         ENDIF 
    471473         !                                             ! =============== 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r7993 r8200  
    20492049 
    20502050   SUBROUTINE mppstop 
     2051    
     2052   USE mod_oasis      ! coupling routines 
     2053 
    20512054      !!---------------------------------------------------------------------- 
    20522055      !!                  ***  routine mppstop  *** 
     
    20582061      !!---------------------------------------------------------------------- 
    20592062      ! 
     2063       
     2064#if defined key_oasis3 
     2065      ! If we're trying to shut down cleanly then we need to consider the fact 
     2066      ! that this could be part of an MPMD configuration - we don't want to 
     2067      ! leave other components deadlocked. 
     2068 
     2069      CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 
     2070 
     2071 
     2072#else 
     2073       
    20602074      CALL mppsync 
    20612075      CALL mpi_finalize( info ) 
     2076#endif 
     2077 
    20622078      ! 
    20632079   END SUBROUTINE mppstop 
     
    39884004            WRITE(kout,*) 
    39894005         ENDIF 
    3990          STOP 'ctl_opn bad opening' 
     4006         CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 
    39914007      ENDIF 
    39924008 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r6486 r8200  
    3131   USE in_out_manager               ! I/O manager 
    3232   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    33  
     33    
    3434   IMPLICIT NONE 
    3535   PRIVATE 
     
    4141   PUBLIC   cpl_freq 
    4242   PUBLIC   cpl_finalize 
     43#if defined key_mpp_mpi 
     44   INCLUDE 'mpif.h' 
     45#endif 
     46    
     47   INTEGER, PARAMETER         :: localRoot  = 0 
     48   LOGICAL                    :: commRank            ! true for ranks doing OASIS communication 
     49#if defined key_cpl_rootexchg 
     50   LOGICAL                    :: rootexchg =.true.   ! logical switch  
     51#else 
     52   LOGICAL                    :: rootexchg =.false.  ! logical switch  
     53#endif  
    4354 
    4455   INTEGER, PUBLIC            ::   OASIS_Rcv  = 1    !: return code if received field 
     
    8293 
    8394   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   exfld   ! Temporary buffer for receiving 
    84  
     95   INTEGER, PUBLIC :: localComm  
     96       
    8597   !!---------------------------------------------------------------------- 
    8698   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     
    120132      IF ( nerror /= OASIS_Ok ) & 
    121133         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
     134      localComm = kl_comm  
    122135      ! 
    123136   END SUBROUTINE cpl_init 
     
    177190      IF( nerror > 0 ) THEN 
    178191         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    179       ENDIF 
     192      ENDIF       
    180193      ! 
    181194      ! ----------------------------------------------------------------- 
    182195      ! ... Define the partition  
    183196      ! ----------------------------------------------------------------- 
    184        
     197             
    185198      paral(1) = 2                                              ! box partitioning 
    186199      paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
     
    196209      ENDIF 
    197210       
    198       CALL oasis_def_partition ( id_part, paral, nerror ) 
     211      CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 
    199212      ! 
    200213      ! ... Announce send variables.  
     
    241254            END DO 
    242255         ENDIF 
    243       END DO 
     256      END DO       
    244257      ! 
    245258      ! ... Announce received variables.  
     
    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.   & 
     
    384397                  kinfo = OASIS_Rcv 
    385398                  IF( llfisrt ) THEN  
    386                      pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     399                     pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm)  
    387400                     llfisrt = .FALSE. 
    388401                  ELSE 
     
    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_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90

    r6486 r8200  
    5151 
    5252   SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1,   & 
    53                        px2 , py2 ) 
     53                       px2 , py2 , kchoix  ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE repcmo  *** 
     
    6868      REAL(wp), INTENT(  out), DIMENSION(jpi,jpj) ::   py2          ! j-componante (defined at v-point) 
    6969      !!---------------------------------------------------------------------- 
    70        
    71       ! Change from geographic to stretched coordinate 
    72       ! ---------------------------------------------- 
    73       CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
    74       CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
    75        
     70      INTEGER, INTENT( IN ) ::   & 
     71         kchoix   ! type of transformation 
     72                  ! = 1 change from geographic to model grid. 
     73                  ! =-1 change from model to geographic grid 
     74      !!---------------------------------------------------------------------- 
     75  
     76      SELECT CASE (kchoix) 
     77      CASE ( 1) 
     78        ! Change from geographic to stretched coordinate 
     79        ! ---------------------------------------------- 
     80      
     81        CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 
     82        CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 
     83      CASE (-1) 
     84       ! Change from stretched to geographic coordinate 
     85       ! ---------------------------------------------- 
     86      
     87       CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 
     88       CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 
     89     END SELECT 
     90      
    7691   END SUBROUTINE repcmo 
    7792 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r8046 r8200  
    207207      ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) )  ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 
    208208#endif 
    209       ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     209      !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 
     210      ! Hardwire only two models as nn_cplmodel has not been read in 
     211      ! from the namelist yet. 
     212      ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) )    
    210213      ! 
    211214      sbc_cpl_alloc = MAXVAL( ierr ) 
     
    321324 
    322325      !                                   ! allocate sbccpl arrays 
    323       IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
     326      !IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    324327      
    325328      ! ================================ ! 
     
    384387         srcv(jpr_otx2:jpr_otz2)%clgrid  = 'V'        !           and           V-point 
    385388         srcv(jpr_itx1:jpr_itz1)%clgrid  = 'F'        ! ice components given at F-point 
    386          srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     389         !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE.     ! receive oce components on grid 1 & 2 
     390! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 
     391         srcv(jpr_otx1)%laction = .TRUE.  
     392         srcv(jpr_oty1)%laction = .TRUE. 
     393! 
    387394         srcv(jpr_itx1:jpr_itz1)%laction = .TRUE.     ! receive ice components on grid 1 only 
    388395      CASE( 'T,I' )  
     
    10351042      INTEGER  ::   ji, jj, jl, jn         ! dummy loop indices 
    10361043      INTEGER  ::   isec                   ! number of seconds since nit000 (assuming rdttra did not change since nit000) 
     1044      INTEGER  ::   ikchoix 
    10371045      REAL(wp) ::   zcumulneg, zcumulpos   ! temporary scalars      
    10381046      REAL(wp) ::   zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in 
     
    10431051      REAL(wp) ::   zcdrag = 1.5e-3        ! drag coefficient 
    10441052      REAL(wp) ::   zzx, zzy               ! temporary variables 
    1045       REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr 
     1053      REAL(wp), POINTER, DIMENSION(:,:) ::   ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 
    10461054      !!---------------------------------------------------------------------- 
    10471055 
     
    10541062      IF( nn_timing == 1 )  CALL timing_start('sbc_cpl_rcv') 
    10551063      ! 
    1056       CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1064      CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    10571065      ! 
    10581066      IF( ln_mixcpl )   zmsk(:,:) = 1. - xcplmask(:,:,0) 
     
    10921100            IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN   ! 2 components oriented along the local grid 
    10931101               !                                                       ! (geographical to local grid -> rotate the components) 
    1094                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
    1095                IF( srcv(jpr_otx2)%laction ) THEN 
    1096                   CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
    1097                ELSE   
    1098                   CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )   
     1102               IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 
     1103                  ! Temporary code for HadGEM3 - will be removed eventually. 
     1104        ! Only applies when we have only taux on U grid and tauy on V grid 
     1105             DO jj=2,jpjm1 
     1106                DO ji=2,jpim1 
     1107                     ztx(ji,jj)=0.25*vmask(ji,jj,1)                & 
     1108                        *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1)    & 
     1109                        +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 
     1110                     zty(ji,jj)=0.25*umask(ji,jj,1)                & 
     1111                        *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1)    & 
     1112                        +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 
     1113                ENDDO 
     1114             ENDDO 
     1115                    
     1116             ikchoix = 1 
     1117             CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 
     1118             CALL lbc_lnk (ztx2,'U', -1. ) 
     1119             CALL lbc_lnk (zty2,'V', -1. ) 
     1120             frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 
     1121             frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 
     1122          ELSE 
     1123             CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx )    
     1124             frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
     1125             IF( srcv(jpr_otx2)%laction ) THEN 
     1126                CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty )    
     1127             ELSE 
     1128                CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty )  
     1129             ENDIF 
     1130          frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid   
    10991131               ENDIF 
    1100                frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:)      ! overwrite 1st component on the 1st grid 
    1101                frcv(jpr_oty1)%z3(:,:,1) = zty(:,:)      ! overwrite 2nd component on the 2nd grid 
    11021132            ENDIF 
    11031133            !                               
     
    14191449 
    14201450      ! 
    1421       CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr ) 
     1451      CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 
    14221452      ! 
    14231453      IF( nn_timing == 1 )  CALL timing_stop('sbc_cpl_rcv') 
     
    21012131      ! 
    21022132      INTEGER ::   ji, jj, jl   ! dummy loop indices 
     2133      INTEGER ::   ikchoix 
    21032134      INTEGER ::   isec, info   ! local integer 
    21042135      REAL(wp) ::   zumax, zvmax 
     
    23652396         !                                                  j+1   j     -----V---F 
    23662397         ! surface velocity always sent from T point                     !       | 
    2367          !                                                        j      |   T   U 
     2398         ! [except for HadGEM3]                                   j      |   T   U 
    23682399         !                                                               |       | 
    23692400         !                                                   j    j-1   -I-------| 
     
    23772408            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
    23782409            CASE( 'oce only'             )      ! C-grid ==> T 
    2379                DO jj = 2, jpjm1 
    2380                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    2381                      zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
    2382                      zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2410               IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2411                  DO jj = 2, jpjm1 
     2412                     DO ji = fs_2, fs_jpim1   ! vector opt. 
     2413                        zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj  ,1) ) 
     2414                        zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji  ,jj-1,1) )  
     2415                     END DO 
    23832416                  END DO 
    2384                END DO 
     2417               ELSE 
     2418! Temporarily Changed for UKV 
     2419                  DO jj = 2, jpjm1 
     2420                     DO ji = 2, jpim1 
     2421                        zotx1(ji,jj) = un(ji,jj,1) 
     2422                        zoty1(ji,jj) = vn(ji,jj,1) 
     2423                     END DO 
     2424                  END DO 
     2425               ENDIF  
    23852426            CASE( 'weighted oce and ice' )    
    23862427               SELECT CASE ( cp_ice_msh ) 
     
    24412482                  END DO 
    24422483               CASE( 'F' )                      ! Ocean on C grid, Ice on F-point (B-grid) ==> T 
    2443                   DO jj = 2, jpjm1 
    2444                      DO ji = 2, jpim1   ! NO vector opt. 
    2445                         zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj  ,1) ) * zfr_l(ji,jj)   &    
    2446                            &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
    2447                            &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
    2448                         zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji  ,jj-1,1) ) * zfr_l(ji,jj)   &  
    2449                            &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
    2450                            &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2484                  IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2485                     DO jj = 2, jpjm1 
     2486                        DO ji = 2, jpim1   ! NO vector opt. 
     2487                           zotx1(ji,jj) = 0.5  * ( un(ji,jj,1)      + un(ji-1,jj,1) ) * zfr_l(ji,jj)   &    
     2488                                &         + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1)                     & 
     2489                                &                  + u_ice(ji-1,jj  ) + u_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2490                           zoty1(ji,jj) = 0.5  * ( vn(ji,jj,1)      + vn(ji,jj-1,1) ) * zfr_l(ji,jj)   & 
     2491                                &         + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1)                     & 
     2492                                &                  + v_ice(ji-1,jj  ) + v_ice(ji,jj  )  ) *  fr_i(ji,jj) 
     2493                        END DO 
    24512494                     END DO 
    2452                   END DO 
     2495#if defined key_cice 
     2496                  ELSE 
     2497! Temporarily Changed for HadGEM3 
     2498                     DO jj = 2, jpjm1 
     2499                        DO ji = 2, jpim1   ! NO vector opt. 
     2500                           zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1)             & 
     2501                                &              + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) )  
     2502                           zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1)             & 
     2503                                &              + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) )  
     2504                        END DO 
     2505                     END DO 
     2506#endif 
     2507                  ENDIF 
    24532508               END SELECT 
    24542509            END SELECT 
     
    24602515         IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN             ! Rotation of the components 
    24612516            !                                                                     ! Ocean component 
    2462             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component  
    2463             CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component  
    2464             zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components  
    2465             zoty1(:,:) = ztmp2(:,:) 
    2466             IF( ssnd(jps_ivx1)%laction ) THEN                                     ! Ice component 
    2467                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component  
    2468                CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component  
    2469                zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components  
    2470                zity1(:,:) = ztmp2(:,:) 
    2471             ENDIF 
     2517            IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 
     2518               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 )       ! 1st component 
     2519               CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 )       ! 2nd component 
     2520               zotx1(:,:) = ztmp1(:,:)                                                   ! overwrite the components 
     2521               zoty1(:,:) = ztmp2(:,:) 
     2522               IF( ssnd(jps_ivx1)%laction ) THEN                                  ! Ice component 
     2523                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 )    ! 1st component 
     2524                  CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 )    ! 2nd component 
     2525                  zitx1(:,:) = ztmp1(:,:)                                                ! overwrite the components 
     2526                  zity1(:,:) = ztmp2(:,:) 
     2527               ENDIF 
     2528            ELSE 
     2529               ! Temporary code for HadGEM3 - will be removed eventually. 
     2530               ! Only applies when we want uvel on U grid and vvel on V grid 
     2531               ! Rotate U and V onto geographic grid before sending. 
     2532 
     2533               DO jj=2,jpjm1 
     2534                  DO ji=2,jpim1 
     2535                     ztmp1(ji,jj)=0.25*vmask(ji,jj,1)                  & 
     2536                          *(zotx1(ji,jj)+zotx1(ji-1,jj)    & 
     2537                          +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 
     2538                     ztmp2(ji,jj)=0.25*umask(ji,jj,1)                  & 
     2539                          *(zoty1(ji,jj)+zoty1(ji+1,jj)    & 
     2540                          +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 
     2541                  ENDDO 
     2542               ENDDO 
     2543                
     2544               ! Ensure any N fold and wrap columns are updated 
     2545               CALL lbc_lnk(ztmp1, 'V', -1.0) 
     2546               CALL lbc_lnk(ztmp2, 'U', -1.0) 
     2547                
     2548               ikchoix = -1 
     2549               CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 
     2550           ENDIF 
    24722551         ENDIF 
    24732552         ! 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r6500 r8200  
    302302      CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 
    303303      ! 
     304      ! In coupled mode get extra fields from CICE for passing back to atmosphere 
     305  
     306      IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 
     307      !  
    304308      IF( nn_timing == 1 )  CALL timing_stop('cice_sbc_init') 
    305309      ! 
     
    736740      IF( nn_timing == 1 )  CALL timing_start('cice_sbc_hadgam') 
    737741      ! 
    738       IF( kt == nit000 )  THEN 
    739          IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 
    740          IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 
    741       ENDIF 
    742  
    743742      !                                         ! =========================== ! 
    744743      !                                         !   Prepare Coupling fields   ! 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7993 r8200  
    266266      ENDIF 
    267267      ! 
    268       IF( lk_oasis )   CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
    269       !                                                     !                                            (2) the use of nn_fsbc 
     268      IF( lk_oasis ) THEN 
     269         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )          
     270         CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step 
     271                                      !                                            (2) the use of nn_fsbc 
     272      ENDIF 
    270273 
    271274!     nn_fsbc initialization if OPA-SAS coupling via OASIS 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90

    r7179 r8200  
    327327               END DO 
    328328            ELSE 
    329                IF(lwp) WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 
    330                IF(lwp) WRITE(numout,*) '         We stop' 
    331                STOP 'ldfght' 
     329               WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 
     330               WRITE(numout,*) '         We stop' 
     331               CALL ctl_stop( 'STOP', 'ldfght : unexpected kaht value') 
    332332            ENDIF 
    333333            !                                             ! =============== 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7563 r8200  
    6868   USE icbini          ! handle bergs, initialisation 
    6969   USE icbstp          ! handle bergs, calving, themodynamics and transport 
     70   USE sbccpl  
    7071   USE cpl_oasis3      ! OASIS3 coupling 
    7172   USE c1d             ! 1D configuration 
     
    169170            CALL stp                         ! AGRIF: time stepping 
    170171#else 
    171             CALL stp( istp )                 ! standard time stepping 
     172            IF (lk_oasis) CALL sbc_cpl_snd( istp )  ! Coupling to atmos 
     173       CALL stp( istp ) 
     174            ! We don't couple on the final timestep because 
     175            ! our restart file has already been written 
     176            ! and contains all the necessary data for a 
     177            ! restart. sbc_cpl_snd could be called here 
     178            ! but it would require 
     179            ! a) A test to ensure it was not performed 
     180            !    on the very last time-step 
     181            ! b) the presence of another call to 
     182            !    sbc_cpl_snd call prior to the main DO loop 
     183            ! This solution produces identical results 
     184            ! with fewer lines of code.  
    172185#endif 
    173186            istp = istp + 1 
     
    283296      IF( Agrif_Root() ) THEN 
    284297         IF( lk_oasis ) THEN 
    285             CALL cpl_init( "oceanx", ilocal_comm )                     ! nemo local communicator given by oasis 
     298            CALL cpl_init( "toyoce", ilocal_comm )                     ! nemo local communicator given by oasis 
    286299            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios 
    287300         ELSE 
     
    294307      IF( lk_oasis ) THEN 
    295308         IF( Agrif_Root() ) THEN 
    296             CALL cpl_init( "oceanx", ilocal_comm )                      ! nemo local communicator given by oasis 
     309            CALL cpl_init( "toyoce", ilocal_comm )                      ! nemo local communicator given by oasis 
    297310         ENDIF 
    298311         ! Nodes selection (control print return in cltxt) 
     
    474487      IF( lk_asminc     )   CALL asm_inc_init   ! Initialize assimilation increments 
    475488      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 
     489       
     490      IF (nstop > 0) THEN 
     491        CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 
     492      END IF 
     493 
    476494      ! 
    477495   END SUBROUTINE nemo_init 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7962 r8200  
    370370                               CALL ctl_stop( 'step: indic < 0' ) 
    371371                               CALL dia_wri_state( 'output.abort', kstp ) 
     372                               CALL ctl_stop('STOP','NEMO failure in stp') 
    372373      ENDIF 
    373374      IF( kstp == nit000   )   THEN 
     
    380381      ! Coupled mode 
    381382      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    382       IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
     383      !IF( lk_oasis         )   CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges 
    383384      ! 
    384385#if defined key_iomput 
  • branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r6486 r8200  
    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.