Changeset 5299


Ignore:
Timestamp:
2015-05-27T18:17:08+02:00 (5 years ago)
Author:
smasson
Message:

dev_r5218_CNRS17_coupling: bugfixes

Location:
branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5220 r5299  
    2828   USE thd_ice        ! LIM thermodynamic sea-ice variables 
    2929   USE dom_ice        ! LIM sea-ice domain 
    30    USE domvvl         ! domain: variable volume level 
    3130   USE limthd_dif     ! LIM: thermodynamics, vertical diffusion 
    3231   USE limthd_dh      ! LIM: thermodynamics, ice and snow thickness variation 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r5147 r5299  
    121121      CALL set_scalar 
    122122 
    123       IF( TRIM(cdname) == "nemo" ) THEN   
     123      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    124124         CALL set_grid( "T", glamt, gphit )  
    125125         CALL set_grid( "U", glamu, gphiu ) 
     
    128128      ENDIF 
    129129 
    130       IF( TRIM(cdname) == "nemo_crs" ) THEN   
     130      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    131131         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    132132         ! 
     
    12001200      CALL iom_swap( cdname )   ! swap to cdname context 
    12011201      CALL xios_update_calendar(kt) 
    1202       IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1202      IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12031203      ! 
    12041204   END SUBROUTINE iom_setkt 
     
    12101210         CALL iom_swap( cdname )   ! swap to cdname context 
    12111211         CALL xios_context_finalize() ! finalize the context 
    1212          IF( cdname /= "nemo" ) CALL iom_swap( "nemo" )   ! return back to nemo context 
     1212         IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) )   ! return back to nemo context 
    12131213      ENDIF 
    12141214      ! 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r4990 r5299  
    2525   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2626   USE sbc_ice, ONLY : lk_lim3 
     27   USE sbc_oce, ONLY : nn_components, jp_iam_opa 
    2728 
    2829   IMPLICIT NONE 
     
    121122                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
    122123                     ! 
    123       IF( lk_lim3 )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
     124      IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) )  CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    124125                     ! 
    125126                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
     
    134135                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
    135136#endif 
    136                   IF( lk_lim3 ) THEN 
     137                  IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN 
    137138                     CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev'  , fraqsr_1lev     ) !clem modif 
    138139                  ENDIF 
     
    214215         CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    215216         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
    216          IF( lk_lim3 )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
     217! EM Attention Ceci doit etre reimplemente correctement 
     218!EM         IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) )   CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
     219         CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 
    217220      ELSE 
    218221         neuler = 0 
     
    257260         ENDIF 
    258261 
    259          IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN 
     262         IF( ( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) .AND. .NOT. lk_vvl ) THEN 
    260263            DO jk = 1, jpk 
    261264               fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 
     
    265268      ENDIF 
    266269      ! 
    267       IF( lk_lim3 ) THEN 
     270!EM Idem 
     271!EM      IF( lk_lim3 .OR. ( nn_components == jp_iam_opa ) ) THEN 
    268272         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 
    269       ENDIF 
     273!EM      ENDIF 
    270274      ! 
    271275   END SUBROUTINE rst_read 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90

    r5220 r5299  
    433433      ! 
    434434      DO ji = 1, nsnd 
    435          DO jm = 1, ncplmodel 
    436             IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
    437                IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) id = ssnd(ji)%nid(1,jm) 
    438             ENDIF 
    439          ENDDO 
     435         IF (ssnd(ji)%laction ) THEN 
     436            DO jm = 1, ncplmodel 
     437               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
     438                  IF( TRIM(cdfieldname) == TRIM(ssnd(ji)%clname) ) THEN 
     439                     id = ssnd(ji)%nid(1,jm) 
     440                  ENDIF 
     441               ENDIF 
     442            ENDDO 
     443         ENDIF 
    440444      ENDDO 
    441445      DO ji = 1, nrcv 
    442          DO jm = 1, ncplmodel 
    443             IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
    444                IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) id = srcv(ji)%nid(1,jm) 
    445             ENDIF 
    446          ENDDO 
     446         IF (srcv(ji)%laction ) THEN 
     447            DO jm = 1, ncplmodel 
     448               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
     449                  IF( TRIM(cdfieldname) == TRIM(srcv(ji)%clname) ) THEN 
     450                     id = srcv(ji)%nid(1,jm) 
     451                  ENDIF 
     452               ENDIF 
     453            ENDDO 
     454         ENDIF 
    447455      ENDDO 
    448456      ! 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r5220 r5299  
    3333   USE cpl_oasis3      ! OASIS3 coupling 
    3434   USE geo2ocean       !  
    35    USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb 
     35   USE oce   , ONLY : tsn, un, vn, sshn, ub, vb, tsb, sshb, fraqsr_1lev 
    3636   USE albedo          ! 
    3737   USE in_out_manager  ! I/O manager 
     
    9898   INTEGER, PARAMETER ::   jpr_ssh    = 39            ! sea surface height 
    9999   INTEGER, PARAMETER ::   jpr_fice   = 40            ! ice fraction           
    100    INTEGER, PARAMETER ::   jprcv      = 40            ! total number of fields received 
    101  
    102    INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction  
     100   INTEGER, PARAMETER ::   jpr_e3t1st = 41            ! first T level thickness  
     101   INTEGER, PARAMETER ::   jpr_fraqsr = 42            ! fraction of solar net radiation absorbed in the first ocean level 
     102   INTEGER, PARAMETER ::   jprcv      = 42            ! total number of fields received 
     103 
     104   INTEGER, PARAMETER ::   jps_fice   =  1            ! ice fraction sent to the atmosphere 
    103105   INTEGER, PARAMETER ::   jps_toce   =  2            ! ocean temperature 
    104106   INTEGER, PARAMETER ::   jps_tice   =  3            ! ice   temperature 
     
    125127   INTEGER, PARAMETER ::   jps_rnf    = 24            ! runoffs 
    126128   INTEGER, PARAMETER ::   jps_taum   = 25            ! wind stress module 
    127    INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent twice if atmos and ice coupled via OASIS 
    128    INTEGER, PARAMETER ::   jpsnd      = 26            ! total number of fields sended 
     129   INTEGER, PARAMETER ::   jps_fice2  = 26            ! ice fraction sent to OPA (by SAS when doing SAS-OPA coupling) 
     130   INTEGER, PARAMETER ::   jps_e3t1st = 27            ! first level depth (vvl) 
     131   INTEGER, PARAMETER ::   jps_fraqsr = 28            ! fraction of solar net radiation absorbed in the first ocean level 
     132   INTEGER, PARAMETER ::   jpsnd      = 28            ! total number of fields sended 
    129133 
    130134   !                                                         !!** namelist namsbc_cpl ** 
     
    156160 
    157161   !! Substitution 
     162#  include "domzgr_substitute.h90" 
    158163#  include "vectopt_loop_substitute.h90" 
    159164   !!---------------------------------------------------------------------- 
     
    229234      IF(lwm) WRITE ( numond, namsbc_cpl ) 
    230235 
    231       IF(lwp .AND. nn_components /= jp_iam_opa ) THEN                        ! control print 
     236      IF(lwp) THEN                        ! control print 
    232237         WRITE(numout,*) 
    233238         WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    234239         WRITE(numout,*)'~~~~~~~~~~~~' 
     240      ENDIF 
     241      IF( lwp .AND. nn_components /= jp_iam_opa .AND. ln_cpl ) THEN                        ! control print 
    235242         WRITE(numout,*)'  received fields (mutiple ice categogies)' 
    236243         WRITE(numout,*)'      10m wind module                 = ', TRIM(sn_rcv_w10m%cldes  ), ' (', TRIM(sn_rcv_w10m%clcat  ), ')' 
     
    472479      srcv(jpr_sflx)%clname = 'O_SFLX' 
    473480      srcv(jpr_fice)%clname = 'RIceFrc' 
    474       !                                                      ! -------------------------------- ! 
    475       !                                                      !   OPA-SAS coupling - rcv by sas  !    
    476       !                                                      ! -------------------------------- ! 
    477       srcv(jpr_toce)%clname = 'I_SSTSST' 
    478       srcv(jpr_soce)%clname = 'I_SSSal' 
    479       srcv(jpr_ocx1)%clname = 'I_OCurx1' 
    480       srcv(jpr_ocy1)%clname = 'I_OCury1' 
    481       srcv(jpr_ssh)%clname  = 'I_SSHght' 
    482  
     481      ! 
    483482      IF( nn_components == jp_iam_opa ) THEN    ! OPA coupled to SAS via OASIS: force received field by OPA (sent by SAS) 
    484483         srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
    485          srcv(jpr_fice )%laction = .TRUE. 
    486          srcv( (/jpr_taum, jpr_otx1, jpr_oty1 /) )%laction = .TRUE. 
    487          srcv(jpr_otx1)%clgrid  = 'U'        ! oce components given at U-point 
    488          srcv(jpr_oty1)%clgrid  = 'V'        !           and           V-point 
     484         srcv( (/jpr_qsroce, jpr_qnsoce, jpr_oemp, jpr_sflx, jpr_fice, jpr_otx1, jpr_oty1, jpr_taum/) )%laction = .TRUE. 
     485         srcv(jpr_otx1)%clgrid = 'U'        ! oce components given at U-point 
     486         srcv(jpr_oty1)%clgrid = 'V'        !           and           V-point 
    489487         sn_rcv_tau%clvgrd = 'U,V' 
    490488         sn_rcv_tau%clvor = 'local grid' 
    491489         sn_rcv_tau%clvref = 'spherical' 
    492          srcv( (/jpr_qsroce, jpr_qnsoce /) )%laction = .TRUE. 
    493          srcv( (/jpr_oemp, jpr_sflx/) )%laction = .TRUE. 
    494490         sn_rcv_emp%cldes = 'oce only' 
     491         ! 
    495492         IF(lwp) THEN                        ! control print 
    496493            WRITE(numout,*) 
    497             WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    498494            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
    499495            WRITE(numout,*)'               OPA component  ' 
     
    509505            WRITE(numout,*) 
    510506         ENDIF 
    511       ELSE IF( nn_components == jp_iam_sas ) THEN 
     507      ENDIF 
     508      !                                                      ! -------------------------------- ! 
     509      !                                                      !   OPA-SAS coupling - rcv by sas  !    
     510      !                                                      ! -------------------------------- ! 
     511      srcv(jpr_toce  )%clname = 'I_SSTSST' 
     512      srcv(jpr_soce  )%clname = 'I_SSSal' 
     513      srcv(jpr_ocx1  )%clname = 'I_OCurx1' 
     514      srcv(jpr_ocy1  )%clname = 'I_OCury1' 
     515      srcv(jpr_ssh   )%clname = 'I_SSHght' 
     516      srcv(jpr_e3t1st)%clname = 'I_E3T1st'    
     517      srcv(jpr_fraqsr)%clname = 'I_FraQsr'    
     518      ! 
     519      IF( nn_components == jp_iam_sas ) THEN 
    512520         IF( .NOT. ln_cpl ) srcv(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
    513          srcv(jpr_toce )%laction = .TRUE. ; srcv(jpr_soce )%laction = .TRUE. ; srcv(jpr_ocx1 )%laction = .TRUE. ; 
    514          srcv(jpr_ocy1 )%laction = .TRUE. ; srcv(jpr_ssh  )%laction = .TRUE. 
     521         srcv( (/jpr_toce, jpr_soce, jpr_ssh, jpr_e3t1st, jpr_fraqsr, jpr_ocx1, jps_ocy1/) )%laction = .TRUE. 
    515522         ! Vectors: change of sign at north fold ONLY if on the local grid 
    516523         srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 
     
    519526            IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
    520527         END DO 
     528         ! 
    521529         IF(lwp) THEN                        ! control print 
     530            WRITE(numout,*) 
     531            WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
     532            WRITE(numout,*)'               SAS component  ' 
     533            WRITE(numout,*) 
    522534            IF( .NOT. ln_cpl ) THEN 
    523                WRITE(numout,*) 
    524                WRITE(numout,*)'sbc_cpl_init : namsbc_cpl namelist ' 
    525                WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
    526                WRITE(numout,*)'               SAS component  ' 
    527                WRITE(numout,*) 
    528535               WRITE(numout,*)'  received fields from OPA component ' 
    529536            ELSE 
    530                WRITE(numout,*) 
    531                WRITE(numout,*)'               Special conditions for SAS-OPA coupling  ' 
    532                WRITE(numout,*)'               SAS component  ' 
    533                WRITE(numout,*) 
    534537               WRITE(numout,*)'  Additional received fields from OPA component : ' 
    535538            ENDIF 
    536             WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     539            WRITE(numout,*)'               sea surface temperature (Celcius) ' 
    537540            WRITE(numout,*)'               sea surface salinity '  
    538541            WRITE(numout,*)'               surface currents '  
    539542            WRITE(numout,*)'               sea surface height '  
     543            WRITE(numout,*)'               thickness of first ocean T level '         
     544            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
    540545            WRITE(numout,*) 
    541546         ENDIF 
    542547      ENDIF 
    543       ! Allocate all parts of frcv used for received fields 
     548       
     549      ! =================================================== ! 
     550      ! Allocate all parts of frcv used for received fields ! 
     551      ! =================================================== ! 
    544552      DO jn = 1, jprcv 
    545553         IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     
    549557      ! Allocate w10m part of frcv which is used even when not received as coupling field 
    550558      IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     559      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
     560      IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     561      IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    551562      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    552563      IF( k_ice /= 0 ) THEN 
     
    666677      !                                                      !   OPA-SAS coupling - snd by opa !    
    667678      !                                                      ! ------------------------------- ! 
    668       ssnd(jps_ssh )%clname = 'O_SSHght'  
    669       ssnd(jps_soce)%clname = 'O_SSSal'  
     679      ssnd(jps_ssh   )%clname = 'O_SSHght'  
     680      ssnd(jps_soce  )%clname = 'O_SSSal'  
     681      ssnd(jps_e3t1st)%clname = 'O_E3T1st'    
     682      ssnd(jps_fraqsr)%clname = 'O_FraQsr' 
     683      ! 
     684      IF( nn_components == jp_iam_opa ) THEN 
     685         ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
     686         ssnd( (/jps_toce, jps_soce, jps_ssh, jps_e3t1st, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. 
     687         ! vector definition: not used but cleaner... 
     688         ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
     689         ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
     690         sn_snd_crt%clvgrd = 'U,V' 
     691         sn_snd_crt%clvor = 'local grid' 
     692         sn_snd_crt%clvref = 'spherical' 
     693         ! 
     694         IF(lwp) THEN                        ! control print 
     695            WRITE(numout,*) 
     696            WRITE(numout,*)'  sent fields to SAS component ' 
     697            WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
     698            WRITE(numout,*)'               sea surface salinity '  
     699            WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
     700            WRITE(numout,*)'               sea surface height '  
     701            WRITE(numout,*)'               thickness of first ocean T level '         
     702            WRITE(numout,*)'               fraction of solar net radiation absorbed in the first ocean level' 
     703            WRITE(numout,*) 
     704         ENDIF 
     705      ENDIF 
    670706      !                                                      ! ------------------------------- ! 
    671707      !                                                      !   OPA-SAS coupling - snd by sas !    
     
    680716      ssnd(jps_rnf   )%clname = 'I_Runoff'    
    681717      ssnd(jps_taum  )%clname = 'I_TauMod'    
    682  
    683       ! NEMO coupled to sea ice with OASIS 
    684       IF( nn_components == jp_iam_opa ) THEN 
    685          ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
    686          ssnd( jps_ssh )%laction = .TRUE. ; ssnd(jps_soce)%laction = .TRUE. 
    687          ssnd( jps_toce )%laction = .TRUE. ; ssnd( (/jps_ocx1,jps_ocy1/) )%laction = .TRUE. 
    688          ssnd(jps_ocx1)%clgrid  = 'U'        ! oce components given at U-point 
    689          ssnd(jps_ocy1)%clgrid  = 'V'        !           and           V-point 
    690          sn_snd_crt%clvgrd = 'U,V' 
    691          sn_snd_crt%clvor = 'local grid' 
    692          sn_snd_crt%clvref = 'spherical' 
    693          IF(lwp) THEN                        ! control print 
    694             WRITE(numout,*) 
    695             WRITE(numout,*)'  sent fields to SAS component ' 
    696             WRITE(numout,*)'               sea surface temperature (T before, Celcius) ' 
    697             WRITE(numout,*)'               sea surface salinity '  
    698             WRITE(numout,*)'               surface currents U,V on local grid and spherical coordinates'  
    699             WRITE(numout,*)'               sea surface height '  
    700             WRITE(numout,*) 
    701          ENDIF 
    702       ! Sea ice coupled to NEMO with OASIS 
    703       ELSE IF( nn_components == jp_iam_sas ) THEN 
     718      ! 
     719      IF( nn_components == jp_iam_sas ) THEN 
    704720         IF( .NOT. ln_cpl ) ssnd(:)%laction = .FALSE.   ! force default definition in case of opa <-> sas coupling 
    705          ssnd(jps_qsroce)%laction = .TRUE. ; ssnd(jps_qnsoce)%laction = .TRUE. ; ssnd(jps_oemp)%laction = .TRUE.  
    706          ssnd(jps_sflx  )%laction = .TRUE. ; ssnd(jps_otx1  )%laction = .TRUE. ; ssnd(jps_oty1)%laction = .TRUE.  
    707          ssnd(jps_taum  )%laction = .TRUE.  
    708          ssnd(jps_fice2)%laction = .TRUE.    ! fr_i defined in sas, even if nn_ice == 0 
    709          sn_snd_thick%clcat = 'no' 
    710          IF (.NOT. ln_cpl) ssnd(jps_fice)%laction = .FALSE. 
     721         ssnd( (/jps_qsroce, jps_qnsoce, jps_oemp, jps_fice2, jps_sflx, jps_otx1, jps_oty1, jps_taum/) )%laction = .TRUE. 
     722         ! 
    711723         ! Change first letter to couple with atmosphere if already coupled with sea_ice 
     724         ! this is nedeed as each variable name used in the namcouple must be unique: 
     725         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
    712726         DO jn = 1, jpsnd 
    713727            IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
    714728         END DO 
     729         ! 
    715730         IF(lwp) THEN                        ! control print 
     731            WRITE(numout,*) 
    716732            IF( .NOT. ln_cpl ) THEN 
    717                WRITE(numout,*) 
    718733               WRITE(numout,*)'  sent fields to OPA component ' 
    719734            ELSE 
    720                WRITE(numout,*) 
    721735               WRITE(numout,*)'  Additional sent fields to OPA component : ' 
    722                WRITE(numout,*)'                  ice cover ' 
    723                WRITE(numout,*)'                  oce only EMP  ' 
    724                WRITE(numout,*)'                  salt flux  ' 
    725                WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
    726                WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
    727                WRITE(numout,*)'                  wind stress U,V components' 
    728                WRITE(numout,*)'                  wind stress module' 
    729736            ENDIF 
     737            WRITE(numout,*)'                  ice cover ' 
     738            WRITE(numout,*)'                  oce only EMP  ' 
     739            WRITE(numout,*)'                  salt flux  ' 
     740            WRITE(numout,*)'                  mixed oce-ice solar flux  ' 
     741            WRITE(numout,*)'                  mixed oce-ice non solar flux  ' 
     742            WRITE(numout,*)'                  wind stress U,V components' 
     743            WRITE(numout,*)'                  wind stress module' 
    730744         ENDIF 
    731745      ENDIF 
     
    891905         ! 
    892906      ENDIF 
    893        
    894907      !                                                      ! ========================= ! 
    895908      !                                                      !    wind stress module     !   (taum) 
     
    920933         ENDIF 
    921934      ENDIF 
    922        
     935      ! 
    923936      !                                                      ! ========================= ! 
    924937      !                                                      !      10 m wind speed      !   (wndm) 
     
    984997      !                                                      !        SSH         ! 
    985998      !                                                      ! ================== ! 
    986       IF( srcv(jpr_ssh )%laction )   ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
    987        
     999      IF( srcv(jpr_ssh )%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1000         ssh_m(:,:) = frcv(jpr_ssh )%z3(:,:,1) 
     1001         sshn( :,:) = ssh_m(:,:) 
     1002      ENDIF 
    9881003      !                                                      ! ================== ! 
    9891004      !                                                      !  surface currents  ! 
    9901005      !                                                      ! ================== ! 
    991       IF( srcv(jpr_ocx1)%laction ) THEN 
     1006      IF( srcv(jpr_ocx1)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
    9921007         ssu_m(:,:) = frcv(jpr_ocx1)%z3(:,:,1) 
    993          ub (:,:,1       ) = ssu_m(:,:) 
     1008         ub (:,:,1) = ssu_m(:,:) 
    9941009      ENDIF 
    9951010      IF( srcv(jpr_ocy1)%laction ) THEN 
    9961011         ssv_m(:,:) = frcv(jpr_ocy1)%z3(:,:,1) 
    997          vb (:,:,1       ) = ssv_m(:,:) 
     1012         vb (:,:,1) = ssv_m(:,:) 
     1013      ENDIF 
     1014      !                                                      ! ======================== ! 
     1015      !                                                      !  first T level thickness ! 
     1016      !                                                      ! ======================== ! 
     1017      IF( srcv(jpr_e3t1st )%laction ) THEN                   ! received by sas in case of opa <-> sas coupling 
     1018         fse3t_m(:,:) = frcv(jpr_e3t1st )%z3(:,:,1) 
     1019      ENDIF 
     1020      !                                                      ! ================================ ! 
     1021      !                                                      !  fraction of solar net radiation ! 
     1022      !                                                      ! ================================ ! 
     1023      IF( srcv(jpr_fraqsr)%laction ) THEN                      ! received by sas in case of opa <-> sas coupling 
     1024         fraqsr_1lev(:,:) = frcv(jpr_fraqsr)%z3(:,:,1) 
    9981025      ENDIF 
    9991026       
     
    11531180            ! 
    11541181         ENDIF 
    1155  
    11561182         !                                                      ! ======================= ! 
    11571183         !                                                      !     put on ice grid     ! 
     
    15841610      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    15851611      INTEGER ::   isec, info   ! local integer 
     1612      REAL(wp) ::   zumax, zvmax 
    15861613      REAL(wp), POINTER, DIMENSION(:,:)   ::   zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 
    15871614      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmp3, ztmp4    
     
    16011628      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    16021629         IF ( nn_components == jp_iam_opa ) THEN 
    1603             ztmp1(:,:) = tsb(:,:,1,jp_tem) 
     1630            ztmp1(:,:) = tsn(:,:,1,jp_tem) 
    16041631         ELSE 
    16051632            SELECT CASE( sn_snd_temp%cldes) 
     
    16451672      !                                                      !  Ice fraction & Thickness !  
    16461673      !                                                      ! ------------------------- ! 
    1647       ! Send ice fraction field  
    1648       IF( ssnd(jps_fice)%laction .OR. ssnd(jps_fice2)%laction ) THEN 
     1674      ! Send ice fraction field to atmosphere 
     1675      IF( ssnd(jps_fice)%laction ) THEN 
    16491676         SELECT CASE( sn_snd_thick%clcat ) 
    16501677         CASE( 'yes' )   ;   ztmp3(:,:,1:jpl) =  a_i(:,:,1:jpl) 
     
    16521679         CASE default    ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 
    16531680         END SELECT 
    1654          IF( ssnd(jps_fice )%laction )   CALL cpl_snd( jps_fice , isec, ztmp3, info ) 
     1681         IF( ssnd(jps_fice)%laction )   CALL cpl_snd( jps_fice, isec, ztmp3, info ) 
     1682      ENDIF 
     1683       
     1684      ! Send ice fraction field to OPA (sent by SAS in SAS-OPA coupling) 
     1685      IF( ssnd(jps_fice2)%laction ) THEN 
     1686         ztmp3(:,:,1) = fr_i(:,:) 
    16551687         IF( ssnd(jps_fice2)%laction )   CALL cpl_snd( jps_fice2, isec, ztmp3, info ) 
    16561688      ENDIF 
     
    17021734         !                                                               i      i+1 (for I) 
    17031735         IF( nn_components == jp_iam_opa ) THEN 
    1704             zotx1(:,:) = ub(:,:,1)   
    1705             zoty1(:,:) = vb(:,:,1)   
     1736            zotx1(:,:) = un(:,:,1)   
     1737            zoty1(:,:) = vn(:,:,1)   
    17061738         ELSE         
    17071739            SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 
     
    18261858      ! 
    18271859      ! 
    1828       !  Fields sent to ice by ocean model when OASIS coupling 
     1860      !  Fields sent to SAS by OPA when doing OPA<->SAS coupling 
    18291861      !                                                        ! SSH 
    18301862      IF( ssnd(jps_ssh )%laction )  THEN 
     
    18321864         !                          forcing is used (for sea-ice dynamics) 
    18331865         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    1834          ELSE                    ;   ztmp1(:,:) = sshb(:,:) 
     1866         ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
    18351867         ENDIF 
    18361868         CALL cpl_snd( jps_ssh, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     
    18381870      ENDIF 
    18391871      !                                                        ! SSS 
    1840       IF( ssnd(jps_soce)%laction )  THEN 
    1841          ztmp1(:,:) =   tsb(:,:,1,jp_sal) 
    1842          CALL cpl_snd( jps_soce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1872      IF( ssnd(jps_soce  )%laction )  THEN 
     1873         ztmp1(:,:) =  tsn(:,:,1,jp_sal) 
     1874         CALL cpl_snd( jps_soce ,  isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1875      ENDIF 
     1876      !                                                        ! first T level thickness  
     1877      IF( ssnd(jps_e3t1st )%laction )  THEN 
     1878         ztmp1(:,:) =  fse3t_n(:,:,1) 
     1879         CALL cpl_snd( jps_e3t1st,  isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
     1880      ENDIF 
     1881      !                                                        ! Qsr fraction 
     1882      IF( ssnd(jps_fraqsr)%laction )  THEN 
     1883         ztmp1(:,:) =  fraqsr_1lev(:,:)  
     1884         CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 
    18431885      ENDIF 
    18441886      ! 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r5220 r5299  
    309309 
    310310 
    311       IF( nn_components /= jp_iam_sas ) THEN 
    312  
    313                                CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    314       ELSE 
    315       ! 
    316       ! sas currently uses surface temperature and salinity in tsn array 
    317       ! for initialisation 
    318       ! and ub, vb arrays in ice dynamics 
    319       ! so allocate enough of arrays to use 
    320       ! 
    321          ierr3 = 0 
    322          jpm = MAX(jp_tem, jp_sal) 
    323          ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 ) 
    324          ALLOCATE( ub(jpi,jpj,1)     , STAT=ierr1 ) 
    325          ALLOCATE( vb(jpi,jpj,1)     , STAT=ierr2 ) 
    326          IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 ) 
    327          ierr = ierr0 + ierr1 + ierr2 + ierr3 
    328          IF( ierr > 0 ) THEN 
    329             CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays') 
    330          ENDIF 
    331  
    332       ENDIF 
     311      IF( nn_components /= jp_iam_sas )   & 
     312         &                     CALL sbc_ssm_init               ! Sea-surface mean fields initialisation 
    333313      ! 
    334314      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation 
     
    393373      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean 
    394374      CASE( jp_core  )    
    395                              IF( nn_components == jp_iam_sas ) & 
    396                                 CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )     !  OASIS-coupled ice 
     375         IF( nn_components == jp_iam_sas ) & 
     376            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA  
    397377                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean 
    398378                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m) 
     
    400380                                                                        ! 
    401381      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean 
    402       CASE( jp_none  )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OASIS-coupled ice 
    403                                                          ! fluxes qsr, qns, emp, sfx,utau, vtau 
    404                                                          ! sss_m, ssu_m, ssv_m) 
     382      CASE( jp_none  )  
     383         IF( nn_components == jp_iam_opa ) & 
     384                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS 
    405385      CASE( jp_esopa )                                 
    406386                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r5223 r5299  
    5858      REAL(wp) ::   zcoef, zf_sbc       ! local scalar 
    5959      REAL(wp), DIMENSION(jpi,jpj,jpts) :: zts 
    60       REAL(wp), DIMENSION(jpi,jpj)      :: zub, zvb,zdep 
    6160      !!--------------------------------------------------------------------- 
    6261       
    6362      !                                        !* surface T-, U-, V- ocean level variables (T, S, depth, velocity) 
    64       IF( nn_components == jp_iam_opa ) THEN 
    65          DO jj = 1, jpj 
    66             DO ji = 1, jpi 
    67                zts(ji,jj,jp_tem) = tsb(ji,jj,mikt(ji,jj),jp_tem) 
    68                zts(ji,jj,jp_sal) = tsb(ji,jj,mikt(ji,jj),jp_sal) 
    69             END DO 
     63      DO jj = 1, jpj 
     64         DO ji = 1, jpi 
     65            zts(ji,jj,jp_tem) = tsn(ji,jj,mikt(ji,jj),jp_tem) 
     66            zts(ji,jj,jp_sal) = tsn(ji,jj,mikt(ji,jj),jp_sal) 
    7067         END DO 
    71       ELSE 
    72          DO jj = 1, jpj 
    73             DO ji = 1, jpi 
    74                zts(ji,jj,jp_tem) = tsb(ji,jj,mikt(ji,jj),jp_tem) 
    75                zts(ji,jj,jp_sal) = tsb(ji,jj,mikt(ji,jj),jp_sal) 
    76             END DO 
    77          END DO 
    78       ENDIF 
    79       zub(:,:)        = ub (:,:,1       ) 
    80       zvb(:,:)        = vb (:,:,1       ) 
    81       ! 
    82       IF( lk_vvl ) THEN 
    83          zdep(:,:) = fse3t_n(:,:,1) 
    84       ENDIF 
    85       !                                                   ! ---------------------------------------- ! 
     68      END DO 
     69      ! 
    8670      IF( nn_fsbc == 1 ) THEN                             !   Instantaneous surface fields        ! 
    8771         !                                                ! ---------------------------------------- ! 
    88          ssu_m(:,:) = zub(:,:) 
    89          ssv_m(:,:) = zvb(:,:) 
     72         ssu_m(:,:) = ub(:,:,1) 
     73         ssv_m(:,:) = vb(:,:,1) 
    9074         IF( ln_useCT )  THEN    ;   sst_m(:,:) = eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    9175         ELSE                    ;   sst_m(:,:) = zts(:,:,jp_tem) 
     
    9377         sss_m(:,:) = zts(:,:,jp_sal) 
    9478         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    95          IF( nn_components == jp_iam_opa ) THEN 
    96             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    97             ELSE                    ;   ssh_m(:,:) = sshb(:,:) 
    98             ENDIF 
    99          ELSE 
    100             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    101             ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
    102             ENDIF 
    103          ENDIF 
    104          ! 
    105          IF( lk_vvl )   fse3t_m(:,:) = zdep(:,:) 
     79         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     80         ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
     81         ENDIF 
     82         ! 
     83         IF( lk_vvl )   fse3t_m(:,:) = fse3t_n(:,:,1) 
    10684         ! 
    10785      ELSE 
     
    11290            IF(lwp) WRITE(numout,*) '~~~~~~~   mean fields initialised to instantaneous values' 
    11391            zcoef = REAL( nn_fsbc - 1, wp ) 
    114             ssu_m(:,:) = zcoef * zub(:,:) 
    115             ssv_m(:,:) = zcoef * zvb(:,:) 
     92            ssu_m(:,:) = zcoef * ub(:,:,1) 
     93            ssv_m(:,:) = zcoef * vb(:,:,1) 
    11694            IF( ln_useCT )  THEN    ;   sst_m(:,:) = zcoef * eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    11795            ELSE                    ;   sst_m(:,:) = zcoef * zts(:,:,jp_tem) 
     
    11997            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    12098            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    121             IF( nn_components == jp_iam_opa ) THEN 
    122                IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    123                ELSE                    ;   ssh_m(:,:) = zcoef * sshb(:,:) 
    124                ENDIF 
    125             ELSE 
    126                IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    127                ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
    128                ENDIF 
     99            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     100            ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
    129101            ENDIF 
    130102            ! 
    131             IF( lk_vvl )   fse3t_m(:,:) = zcoef * zdep(:,:) 
     103            IF( lk_vvl )   fse3t_m(:,:) = zcoef * fse3t_n(:,:,1) 
    132104            !                                             ! ---------------------------------------- ! 
    133105         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   ! 
     
    143115         !                                                !        Cumulate at each time step        ! 
    144116         !                                                ! ---------------------------------------- ! 
    145          ssu_m(:,:) = ssu_m(:,:) + zub(:,:) 
    146          ssv_m(:,:) = ssv_m(:,:) + zvb(:,:) 
     117         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
     118         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    147119         IF( ln_useCT )  THEN    ;   sst_m(:,:) = sst_m(:,:) + eos_pt_from_ct( zts(:,:,jp_tem), zts(:,:,jp_sal) ) 
    148120         ELSE                    ;   sst_m(:,:) = sst_m(:,:) + zts(:,:,jp_tem) 
     
    150122         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    151123         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    152          IF( nn_components == jp_iam_opa ) THEN 
    153             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    154             ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) 
    155             ENDIF 
    156          ELSE 
    157             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    158             ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshb(:,:) 
    159             ENDIF 
    160          ENDIF 
    161          ! 
    162          IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + zdep(:,:) 
     124         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     125         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     126         ENDIF 
     127         ! 
     128         IF( lk_vvl )   fse3t_m(:,:) = fse3t_m(:,:) + fse3t_n(:,:,1) 
    163129 
    164130         !                                                ! ---------------------------------------- ! 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r4990 r5299  
    233233               END DO 
    234234               ! clem: store attenuation coefficient of the first ocean level 
    235                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     235               IF ( ln_qsr_ice ) THEN 
    236236                  DO jj = 1, jpj 
    237237                     DO ji = 1, jpi 
     
    256256               END DO 
    257257               ! clem: store attenuation coefficient of the first ocean level 
    258                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     258               IF ( ln_qsr_ice ) THEN 
    259259                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    260260               ENDIF 
     
    279279               END DO 
    280280               ! clem: store attenuation coefficient of the first ocean level 
    281                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     281               IF ( ln_qsr_ice ) THEN 
    282282                  DO jj = 1, jpj 
    283283                     DO ji = 1, jpi 
     
    298298               END DO 
    299299               ! clem: store attenuation coefficient of the first ocean level 
    300                IF ( lk_lim3 .AND. ln_qsr_ice ) THEN 
     300               IF ( ln_qsr_ice ) THEN 
    301301                  fraqsr_1lev(:,:) = etot3(:,:,1) / r1_rau0_rcp 
    302302               ENDIF 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r5215 r5299  
    131131 
    132132      ! control print 
    133       IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
     133      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    134134           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    135135 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90

    r5220 r5299  
    9797      !                            !-----------------------! 
    9898#if defined key_agrif 
    99       CALL Agrif_Declare_Var       ! AGRIF: set the meshes 
     99      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
     100      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
     101# if defined key_top 
     102      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP 
     103# endif 
     104# if defined key_lim2 
     105      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM 
     106# endif 
    100107#endif 
    101108      ! check that all process are still there... If some process have an error, 
     
    119126         IF( lk_mpp )   CALL mpp_max( nstop ) 
    120127      END DO 
     128      ! 
     129      IF( ln_icebergs )   CALL icb_end( nitend ) 
     130 
    121131      !                            !------------------------! 
    122132      !                            !==  finalize the run  ==! 
     
    137147      ! 
    138148      CALL nemo_closefile 
     149      ! 
    139150#if defined key_iomput 
    140151      CALL xios_finalize                ! end mpp communications with xios 
     
    160171      INTEGER ::   ilocal_comm   ! local integer       
    161172      INTEGER ::   ios 
    162  
    163173      CHARACTER(len=80), DIMENSION(16) ::   cltxt 
    164       !! 
     174      ! 
    165175      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
    166176         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   & 
     
    169179         &             jpizoom, jpjzoom, jperio, ln_use_jattr 
    170180      !!---------------------------------------------------------------------- 
     181      ! 
    171182      cltxt = '' 
    172183      cxios_context = 'sas' 
     
    198209904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )    
    199210 
     211! Force values for AGRIF zoom (cf. agrif_user.F90) 
     212#if defined key_agrif 
     213   IF( .NOT. Agrif_Root() ) THEN 
     214      jpiglo  = nbcellsx + 2 + 2*nbghostcells 
     215      jpjglo  = nbcellsy + 2 + 2*nbghostcells 
     216      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
     217      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
     218      jpidta  = jpiglo 
     219      jpjdta  = jpjglo 
     220      jpizoom = 1 
     221      jpjzoom = 1 
     222      nperio  = 0 
     223      jperio  = 0 
     224      ln_use_jattr = .false. 
     225   ENDIF 
     226#endif 
     227      ! 
    200228      !                             !--------------------------------------------! 
    201229      !                             !  set communicator & select the local node  ! 
     
    253281      ! than variables 
    254282      IF( Agrif_Root() ) THEN 
     283#if defined key_nemocice_decomp 
     284         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim. 
     285         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
     286#else 
    255287         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim. 
    256 #if defined key_nemocice_decomp 
    257          jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.  
    258 #else 
    259288         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim. 
    260289#endif 
     290      ENDIF 
    261291         jpk = jpkdta                                             ! third dim 
    262292         jpim1 = jpi-1                                            ! inner domain indices 
     
    264294         jpkm1 = jpk-1                                            !   "           " 
    265295         jpij  = jpi*jpj                                          !  jpi x j 
    266       ENDIF 
    267296 
    268297      IF(lwp) THEN                            ! open listing units 
     
    423452      ENDIF 
    424453      ! 
     454      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
     455         &                                               'f2003 standard. '                              ,  & 
     456         &                                               'Compile with key_nosignedzero enabled' ) 
     457      ! 
    425458   END SUBROUTINE nemo_ctl 
    426459 
     
    464497      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass  
    465498      ! 
    466       INTEGER :: ierr,ierr4 
     499      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7 
     500      INTEGER :: jpm 
    467501      !!---------------------------------------------------------------------- 
    468502      ! 
     
    471505      ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             & 
    472506         &      snwice_fmass(jpi,jpj), STAT= ierr4 ) 
    473       ierr = ierr + ierr4 
     507 
     508      jpm = MAX(jp_tem, jp_sal) 
     509      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 ) 
     510      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 ) 
     511      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 ) 
     512      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 ) 
     513      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 ) 
     514      ALLOCATE( fraqsr_1lev(jpi,jpj), STAT=ierr7 ) 
     515 
     516      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 
    474517      ! 
    475518      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
     
    496539      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 
    497540      !!---------------------------------------------------------------------- 
    498  
     541      ! 
    499542      ierr = 0 
    500  
     543      ! 
    501544      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 
    502  
     545      ! 
    503546      IF( nfact <= 1 ) THEN 
    504547         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' 
     
    542585      INTEGER, PARAMETER :: ntest = 14 
    543586      INTEGER :: ilfax(ntest) 
    544  
     587      ! 
    545588      ! lfax contains the set of allowed factors. 
    546589      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  & 
     
    627670          !loop over the other north-fold processes to find the processes 
    628671          !managing the points belonging to the sxT-dxT range 
    629           DO jn = jpnij - jpni +1, jpnij 
    630              IF ( njmppt(jn) == njmppmax ) THEN 
     672   
     673          DO jn = 1, jpni 
    631674                !sxT is the first point (in the global domain) of the jn 
    632675                !process 
    633                 sxT = nimppt(jn) 
     676                sxT = nfiimpp(jn, jpnj) 
    634677                !dxT is the last point (in the global domain) of the jn 
    635678                !process 
    636                 dxT = nimppt(jn) + nlcit(jn) - 1 
     679                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    637680                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    638681                   nsndto = nsndto + 1 
    639                    isendto(nsndto) = jn 
    640                 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 
     682                     isendto(nsndto) = jn 
     683                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    641684                   nsndto = nsndto + 1 
    642685                   isendto(nsndto) = jn 
     
    645688                   isendto(nsndto) = jn 
    646689                END IF 
    647              END IF 
    648690          END DO 
     691          nfsloop = 1 
     692          nfeloop = nlci 
     693          DO jn = 2,jpni-1 
     694           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     695              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     696                 nfsloop = nldi 
     697              ENDIF 
     698              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     699                 nfeloop = nlei 
     700              ENDIF 
     701           ENDIF 
     702        END DO 
     703 
    649704      ENDIF 
    650705      l_north_nogather = .TRUE. 
  • branches/2015/dev_r5218_CNRS17_coupling/NEMOGCM/NEMO/SAS_SRC/step.F90

    r5220 r5299  
    1717   USE dom_oce          ! ocean space and time domain variables  
    1818   USE in_out_manager   ! I/O manager 
     19   USE sbc_oce 
     20   USE sbccpl 
    1921   USE iom              ! 
    2022   USE lbclnk 
     
    8688                                                          ! need to keep the same interface  
    8789                             CALL stp_ctl( kstp, indic ) 
     90      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     91      ! Coupled mode 
     92      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     93      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp )     ! coupled mode : field exchanges if OASIS-coupled ice 
     94 
    8895#if defined key_iomput 
    8996      IF( kstp == nitend .OR. indic < 0 ) THEN  
Note: See TracChangeset for help on using the changeset viewer.