New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12063 for NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE – NEMO

Ignore:
Timestamp:
2019-12-05T11:46:38+01:00 (4 years ago)
Author:
gsamson
Message:

dev_ASINTER-01-05_merged: update branch with dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk@r12061 and trunk@r12055 + bugfix for agrif compatibility in sbcblk: sette tests with ref configs ok except ABL restartability (under investigation) (tickets #2159 and #2131)

Location:
NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE
Files:
17 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/BDY/bdydta.F90

    r11586 r12063  
    171171                        ii = idx_bdy(jbdy)%nbi(ib,igrd) 
    172172                        ij = idx_bdy(jbdy)%nbj(ib,igrd) 
    173                         dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik)          
    174                         dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik)          
     173                        dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     174                        dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
    175175                     END DO 
    176176                  END DO 
    … …  
    447447               ELSE                                                            ;   ipl = 1            ! xy or xyt 
    448448               ENDIF 
     449               bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED'   ! reset to default value as this subdomain may not need to read this bdy 
    449450            ENDIF 
    450451         ENDIF 
    … …  
    615616            ENDIF 
    616617 
    617             IF( llneed ) THEN                                              ! dta_bdy(jbdy)%xxx will be needed 
     618            IF( llneed .AND. iszdim > 0 ) THEN                             ! dta_bdy(jbdy)%xxx will be needed 
    618619               !                                                           !   -> must be associated with an allocated target 
    619620               ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) )              ! allocate the target 
    … …  
    624625                  bf_alias(1)%imap    => idx_bdy(jbdy)%nbmap(1:iszdim,igrd)   ! associate the mapping used for this bdy 
    625626                  bf_alias(1)%igrd    = igrd                                  ! used only for vertical integration of 3D arrays 
     627                  bf_alias(1)%ibdy    = jbdy                                  !  "    "    "     "          "      "  "    "     
    626628                  bf_alias(1)%ltotvel = ln_full_vel                           ! T if u3d is full velocity 
    627629                  bf_alias(1)%lzint   = ln_zinterp                            ! T if it requires a vertical interpolation 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/DYN/dynspg_ts.F90

    r11413 r12063  
    803803 
    804804      IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN  
     805         ! need to set lbc here because not done prior time averaging 
     806         CALL lbc_lnk_multi( 'dynspg_ts', zuwdav2, 'U', 1._wp, zvwdav2, 'V', 1._wp) 
    805807         DO jk = 1, jpkm1 
    806808            un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) & 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/cpl_oasis3.F90

    r10582 r12063  
    114114      !------------------------------------------------------------------ 
    115115      CALL oasis_init_comp ( ncomp_id, TRIM(cd_modname), nerror ) 
    116       IF ( nerror /= OASIS_Ok ) & 
     116      IF( nerror /= OASIS_Ok ) & 
    117117         CALL oasis_abort (ncomp_id, 'cpl_init', 'Failure in oasis_init_comp') 
    118118 
    … …  
    122122 
    123123      CALL oasis_get_localcomm ( kl_comm, nerror ) 
    124       IF ( nerror /= OASIS_Ok ) & 
     124      IF( nerror /= OASIS_Ok ) & 
    125125         CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 
    126126      ! 
    … …  
    149149 
    150150      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    151       IF ( ltmp_wapatch ) THEN 
     151      IF( ltmp_wapatch ) THEN 
    152152         nldi_save = nldi   ;   nlei_save = nlei 
    153153         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    217217      ! 
    218218      DO ji = 1, ksnd 
    219          IF ( ssnd(ji)%laction ) THEN 
     219         IF( ssnd(ji)%laction ) THEN 
    220220 
    221221            IF( ssnd(ji)%nct > nmaxcat ) THEN 
    … …  
    228228               DO jm = 1, kcplmodel 
    229229 
    230                   IF ( ssnd(ji)%nct .GT. 1 ) THEN 
     230                  IF( ssnd(ji)%nct .GT. 1 ) THEN 
    231231                     WRITE(cli2,'(i2.2)') jc 
    232232                     zclname = TRIM(ssnd(ji)%clname)//'_cat'//cli2 
    … …  
    234234                     zclname = ssnd(ji)%clname 
    235235                  ENDIF 
    236                   IF ( kcplmodel  > 1 ) THEN 
     236                  IF( kcplmodel  > 1 ) THEN 
    237237                     WRITE(cli2,'(i2.2)') jm 
    238238                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
    … …  
    241241                  IF( agrif_fixed() /= 0 ) THEN  
    242242                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    243                   END IF 
     243                  ENDIF 
    244244#endif 
    245245                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_Out 
    246246                  CALL oasis_def_var (ssnd(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    247247                     &                OASIS_Out          , ishape , OASIS_REAL, nerror ) 
    248                   IF ( nerror /= OASIS_Ok ) THEN 
     248                  IF( nerror /= OASIS_Ok ) THEN 
    249249                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    250250                     CALL oasis_abort ( ssnd(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
    … …  
    262262      ! 
    263263      DO ji = 1, krcv 
    264          IF ( srcv(ji)%laction ) THEN  
     264         IF( srcv(ji)%laction ) THEN  
    265265             
    266266            IF( srcv(ji)%nct > nmaxcat ) THEN 
    … …  
    273273               DO jm = 1, kcplmodel 
    274274                   
    275                   IF ( srcv(ji)%nct .GT. 1 ) THEN 
     275                  IF( srcv(ji)%nct .GT. 1 ) THEN 
    276276                     WRITE(cli2,'(i2.2)') jc 
    277277                     zclname = TRIM(srcv(ji)%clname)//'_cat'//cli2 
    … …  
    279279                     zclname = srcv(ji)%clname 
    280280                  ENDIF 
    281                   IF ( kcplmodel  > 1 ) THEN 
     281                  IF( kcplmodel  > 1 ) THEN 
    282282                     WRITE(cli2,'(i2.2)') jm 
    283283                     zclname = 'model'//cli2//'_'//TRIM(zclname) 
    … …  
    286286                  IF( agrif_fixed() /= 0 ) THEN  
    287287                     zclname=TRIM(Agrif_CFixed())//'_'//TRIM(zclname) 
    288                   END IF 
     288                  ENDIF 
    289289#endif 
    290290                  IF( ln_ctl ) WRITE(numout,*) "Define", ji, jc, jm, " "//TRIM(zclname), " for ", OASIS_In 
    291291                  CALL oasis_def_var (srcv(ji)%nid(jc,jm), zclname, id_part   , (/ 2, 1 /),   & 
    292292                     &                OASIS_In           , ishape , OASIS_REAL, nerror ) 
    293                   IF ( nerror /= OASIS_Ok ) THEN 
     293                  IF( nerror /= OASIS_Ok ) THEN 
    294294                     WRITE(numout,*) 'Failed to define transient ', ji, jc, jm, " "//TRIM(zclname) 
    295295                     CALL oasis_abort ( srcv(ji)%nid(jc,jm), 'cpl_define', 'Failure in oasis_def_var' ) 
    … …  
    310310      IF( nerror /= OASIS_Ok )   CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in oasis_enddef') 
    311311      ! 
    312       IF ( ltmp_wapatch ) THEN 
     312      IF( ltmp_wapatch ) THEN 
    313313         nldi = nldi_save   ;   nlei = nlei_save 
    314314         nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    332332      !!-------------------------------------------------------------------- 
    333333      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    334       IF ( ltmp_wapatch ) THEN 
     334      IF( ltmp_wapatch ) THEN 
    335335         nldi_save = nldi   ;   nlei_save = nlei 
    336336         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    349349               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
    350350                
    351                IF ( ln_ctl ) THEN         
    352                   IF ( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
     351               IF( ln_ctl ) THEN         
     352                  IF( kinfo == OASIS_Sent     .OR. kinfo == OASIS_ToRest .OR.   & 
    353353                     & kinfo == OASIS_SentOut  .OR. kinfo == OASIS_ToRestOut ) THEN 
    354354                     WRITE(numout,*) '****************' 
    … …  
    368368         ENDDO 
    369369      ENDDO 
    370       IF ( ltmp_wapatch ) THEN 
     370      IF( ltmp_wapatch ) THEN 
    371371         nldi = nldi_save   ;   nlei = nlei_save 
    372372         nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    393393      !!-------------------------------------------------------------------- 
    394394      ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    395       IF ( ltmp_wapatch ) THEN 
     395      IF( ltmp_wapatch ) THEN 
    396396         nldi_save = nldi   ;   nlei_save = nlei 
    397397         nldj_save = nldj   ;   nlej_save = nlej 
    … …  
    403403      ! 
    404404      DO jc = 1, srcv(kid)%nct 
    405          IF ( ltmp_wapatch ) THEN 
     405         IF( ltmp_wapatch ) THEN 
    406406            IF( nimpp           ==      1 ) nldi = 1 
    407407            IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    … …  
    420420                  &        kinfo == OASIS_RecvOut .OR. kinfo == OASIS_FromRestOut 
    421421                
    422                IF ( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
     422               IF( ln_ctl )   WRITE(numout,*) "llaction, kinfo, kstep, ivarid: " , llaction, kinfo, kstep, srcv(kid)%nid(jc,jm) 
    423423                
    424                IF ( llaction ) THEN 
     424               IF( llaction ) THEN 
    425425                   
    426426                  kinfo = OASIS_Rcv 
    … …  
    432432                  ENDIF 
    433433                   
    434                   IF ( ln_ctl ) THEN         
     434                  IF( ln_ctl ) THEN         
    435435                     WRITE(numout,*) '****************' 
    436436                     WRITE(numout,*) 'oasis_get: Incoming ', srcv(kid)%clname 
    … …  
    450450         ENDDO 
    451451 
    452          IF ( ltmp_wapatch ) THEN 
     452         IF( ltmp_wapatch ) THEN 
    453453            nldi = nldi_save   ;   nlei = nlei_save 
    454454            nldj = nldj_save   ;   nlej = nlej_save 
    … …  
    483483      ! 
    484484      DO ji = 1, nsnd 
    485          IF (ssnd(ji)%laction ) THEN 
     485         IF(ssnd(ji)%laction ) THEN 
    486486            DO jm = 1, ncplmodel 
    487487               IF( ssnd(ji)%nid(1,jm) /= -1 ) THEN 
    … …  
    495495      ENDDO 
    496496      DO ji = 1, nrcv 
    497          IF (srcv(ji)%laction ) THEN 
     497         IF(srcv(ji)%laction ) THEN 
    498498            DO jm = 1, ncplmodel 
    499499               IF( srcv(ji)%nid(1,jm) /= -1 ) THEN 
    … …  
    529529      ! 
    530530      DEALLOCATE( exfld ) 
    531       IF (nstop == 0) THEN 
     531      IF(nstop == 0) THEN 
    532532         CALL oasis_terminate( nerror )          
    533533      ELSE 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/cyclone.F90

    r10068 r12063  
    137137            zhemi = SIGN( 1. , zrlat ) 
    138138            zinfl = 15.* rad                             ! clim inflow angle in Tropical Cyclones 
    139          IF ( vortex == 0 ) THEN 
     139         IF( vortex == 0 ) THEN 
    140140 
    141141            ! Vortex Holland reconstruct wind at each lon-lat position 
    … …  
    157157                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    158158 
    159                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     159                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    160160                  ! shape of the wind profile 
    161161                  zztmp = ( zrmw / ( zdist + 1.e-12 ) )**zb 
    162162                  zztmp =  zvmax * SQRT( zztmp * EXP(1. - zztmp) )     
    163163 
    164                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     164                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    165165                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    166166                  ENDIF 
    167167 
    168168                  ! !!! KILL EQ WINDS 
    169                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     169                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    170170                  !    zztmp = 0.                              ! winds in other hemisphere 
    171                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    172                   ! ENDIF 
    173                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     171                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     172                  ! ENDIF 
     173                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    174174                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    175175                  !    !linear to zero between 10 and 5 
    … …  
    177177                  ! !!! / KILL EQ 
    178178 
    179                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     179                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    180180 
    181181                  zwnd_t =   COS( zinfl ) * zztmp     
    … …  
    196196            END DO 
    197197          
    198          ELSE IF ( vortex == 1 ) THEN 
     198         ELSE IF( vortex == 1 ) THEN 
    199199 
    200200            ! Vortex Willoughby reconstruct wind at each lon-lat position 
    … …  
    206206            zn   =   2.1340 + 0.0077*zvmax - 0.4522*LOG(zrmw/1000.) - 0.0038*ABS( ztct(jtc,jp_lat) )             
    207207            zA   =   0.5913 + 0.0029*zvmax - 0.1361*LOG(zrmw/1000.) - 0.0042*ABS( ztct(jtc,jp_lat) )   
    208             IF (zA < 0) THEN  
     208            IF(zA < 0) THEN  
    209209               zA=0 
    210210            ENDIF            
    … …  
    218218                     &              + COS( zrlat ) * COS( zzrgphi ) * COS( zzrglam ) ) 
    219219 
    220                  IF (zdist < zrout2) THEN ! calculation of wind only to a given max radius 
     220                 IF(zdist < zrout2) THEN ! calculation of wind only to a given max radius 
    221221                
    222222                  ! shape of the wind profile                      
    223                   IF (zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
     223                  IF(zdist <= zrmw) THEN     ! inside the Radius of Maximum Wind 
    224224                     zztmp  = zvmax * (zdist/zrmw)**zn 
    225225                  ELSE  
    … …  
    227227                  ENDIF 
    228228 
    229                   IF (zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
     229                  IF(zdist > zrout1) THEN ! bring to zero between r_out1 and r_out2 
    230230                     zztmp = zztmp * ( (zrout2-zdist)*1.e-6 ) 
    231231                  ENDIF 
    232232 
    233233                  ! !!! KILL EQ WINDS 
    234                   ! IF (SIGN( 1. , zrlat ) /= zhemi) THEN 
     234                  ! IF(SIGN( 1. , zrlat ) /= zhemi) THEN 
    235235                  !    zztmp = 0.                              ! winds in other hemisphere 
    236                   !    IF (ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
    237                   ! ENDIF 
    238                   ! IF (ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
     236                  !    IF(ABS(gphit(ji,jj)) <= 5.) zztmp=0.   ! kill between 5N-5S 
     237                  ! ENDIF 
     238                  ! IF(ABS(gphit(ji,jj)) <= 10. .and. ABS(gphit(ji,jj)) > 5.) THEN 
    239239                  !    zztmp = zztmp * ( 1./5. * (ABS(gphit(ji,jj)) - 5.) )  
    240240                  !    !linear to zero between 10 and 5 
    … …  
    242242                  ! !!! / KILL EQ 
    243243 
    244                   IF (ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
     244                  IF(ABS(gphit(ji,jj)) >= 55.) zztmp = 0. ! kill weak spurious winds at high latitude 
    245245 
    246246                  zwnd_t =   COS( zinfl ) * zztmp     

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/fldread.F90

    r11857 r12063  
    167167      IF( PRESENT(kit) )   ll_firstcall = ll_firstcall .and. kit == 1 
    168168 
    169       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     169      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    170170      ELSE                                      ;   it_offset = 0 
    171171      ENDIF 
    … …  
    389389         ENDIF 
    390390         ! 
    391          IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     391         IF( sdjf%cltype(1:4) == 'week' ) THEN 
    392392            isec_week = isec_week + ksec_week( sdjf%cltype(6:8) )   ! second since the beginning of the week 
    393393            llprevmth = isec_week > nsec_month                      ! longer time since the beginning of the week than the month 
    … …  
    464464      ENDIF 
    465465      ! 
    466       IF ( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
     466      IF( nn_components == jp_iam_sas ) THEN   ;   it_offset = nn_fsbc 
    467467      ELSE                                      ;   it_offset = 0 
    468468      ENDIF 
    … …  
    656656            ENDIF 
    657657         CASE DEFAULT 
    658             IF (lk_c1d .AND. lmoor ) THEN 
     658            IF(lk_c1d .AND. lmoor ) THEN 
    659659               IF( sdjf%ln_tint ) THEN 
    660660                  CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
    … …  
    10711071         imonth = kmonth 
    10721072         iday = kday 
    1073          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1073         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10741074            isec_week = ksec_week( sdjf%cltype(6:8) )- (86400 * 8 )   
    10751075            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    … …  
    10801080         ENDIF 
    10811081      ELSE                                                  ! use current day values 
    1082          IF ( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
     1082         IF( sdjf%cltype(1:4) == 'week' ) THEN             ! find the day of the beginning of the week 
    10831083            isec_week  = ksec_week( sdjf%cltype(6:8) )      ! second since the beginning of the week 
    10841084            llprevmth  = isec_week > nsec_month             ! longer time since beginning of the week than the month 
    … …  
    13191319      !! get dimensions 
    13201320      !!GS: we consider 2D data as 3D data with vertical dim size = 1 
    1321       !IF ( SIZE(sd%fnow, 3) > 1 ) THEN 
    1322       IF ( SIZE(sd%fnow, 3) > 0 ) THEN 
     1321      !IF( SIZE(sd%fnow, 3) > 1 ) THEN 
     1322      IF( SIZE(sd%fnow, 3) > 0 ) THEN 
    13231323         ALLOCATE( ddims(4) ) 
    13241324      ELSE 
    … …  
    13331333 
    13341334      CALL iom_open ( sd%wgtname, inum )   ! interpolation weights 
    1335       IF ( inum > 0 ) THEN 
     1335      IF( inum > 0 ) THEN 
    13361336 
    13371337         !! determine whether we have an east-west cyclic grid 
    … …  
    16661666      END DO 
    16671667 
    1668       IF (ref_wgts(kw)%numwgt .EQ. 16) THEN 
     1668      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 
    16691669 
    16701670        !! fix up halo points that we couldnt read from file 
    … …  
    17511751         END DO 
    17521752         ! 
    1753       END IF 
     1753      ENDIF 
    17541754      ! 
    17551755   END SUBROUTINE fld_interp 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbc_oce.F90

    r12015 r12063  
    160160   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-] 
    161161 
    162    !!---------------------------------------------------------------------- 
    163    !!                     Cool-skin/Warm-layer 
    164    !!---------------------------------------------------------------------- 
    165    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tsk       !: sea-surface skin temperature (used if ln_skin_cs==.true. .OR. ln_skin_wl==.true.)  [K] !LB 
    166  
    167     
    168162   !! * Substitutions 
    169163#  include "vectopt_loop_substitute.h90" 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcapr.F90

    r11348 r12063  
    103103      ! 
    104104      !                                            !* control check 
    105       IF ( ln_apr_obc  ) THEN 
     105      IF( ln_apr_obc  ) THEN 
    106106         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    107107      ENDIF 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk.F90

    r12021 r12063  
    5858   USE prtctl         ! Print control 
    5959 
    60    USE sbcblk_phy     !LB: all thermodynamics functions in the marine boundary layer, rho_air, q_sat, etc... 
     60   USE sbcblk_phy     ! a catalog of functions for physical/meteorological parameters in the marine boundary layer, rho_air, q_sat, etc... 
    6161 
    6262 
    … …  
    9595   LOGICAL  ::   ln_ECMWF       ! "ECMWF"     algorithm   (IFS cycle 45r1) 
    9696   ! 
     97   LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
     98   LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
     99   ! 
    97100   REAL(wp)         ::   rn_pfac   ! multiplication factor for precipitation 
    98101   REAL(wp), PUBLIC ::   rn_efac   ! multiplication factor for evaporation 
    … …  
    100103   REAL(wp)         ::   rn_zqt    ! z(q,t) : height of humidity and temperature measurements 
    101104   REAL(wp)         ::   rn_zu     ! z(u)   : height of wind measurements 
    102    ! 
    103    LOGICAL  ::   ln_Cd_L12      ! ice-atm drag = F( ice concentration )                        (Lupkes et al. JGR2012) 
    104    LOGICAL  ::   ln_Cd_L15      ! ice-atm drag = F( ice concentration, atmospheric stability ) (Lupkes et al. JGR2015) 
    105105   ! 
    106106   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   Cd_ice , Ch_ice , Ce_ice   ! transfert coefficients over ice 
    … …  
    140140      !!             ***  ROUTINE sbc_blk_alloc *** 
    141141      !!------------------------------------------------------------------- 
    142       ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   , tsk(jpi,jpj)    ,                    & 
     142      ALLOCATE( t_zu(jpi,jpj)   , q_zu(jpi,jpj)   ,                                      & 
    143143         &      Cdn_oce(jpi,jpj), Chn_oce(jpi,jpj), Cen_oce(jpi,jpj),                    & 
    144144         &      Cd_ice (jpi,jpj), Ch_ice (jpi,jpj), Ce_ice (jpi,jpj), STAT=sbc_blk_alloc ) 
    … …  
    212212         IF( nn_fsbc /= 1 ) & 
    213213            & CALL ctl_stop( 'sbc_blk_init: Please set "nn_fsbc" to 1 when using cool-skin/warm-layer param.')                   
     214      END IF 
     215       
     216      IF( ln_skin_wl ) THEN 
     217         !! Check if the frequency of downwelling solar flux input makes sense and if ln_dm2dc=T if it is daily! 
     218         IF( (sn_qsr%freqh  < 0.).OR.(sn_qsr%freqh  > 24.) ) & 
     219            & CALL ctl_stop( 'sbc_blk_init: Warm-layer param. (ln_skin_wl) not compatible with freq. of solar flux > daily' ) 
     220         IF( (sn_qsr%freqh == 24.).AND.(.NOT. ln_dm2dc) ) & 
     221            & CALL ctl_stop( 'sbc_blk_init: Please set ln_dm2dc=T for warm-layer param. (ln_skin_wl) to work properly' ) 
    214222      END IF 
    215223       
    … …  
    361369      !!      the wind velocity (j-component) at z=rn_zu  (m/s) at T-point 
    362370      !!      the specific humidity           at z=rn_zqt (kg/kg) 
    363       !!      the solar heat                  at z=rn_zqt (W/m2) 
     371      !!      the air temperature             at z=rn_zqt (Kelvin) 
     372      !!      the solar heat                              (W/m2) 
    364373      !!      the Long wave                               (W/m2) 
    365       !!      the air temperature                         (Kelvin) 
    366374      !!      the total precipitation (rain+snow)         (Kg/m2/s) 
    367375      !!      the snow (solid precipitation)              (kg/m2/s) 
    … …  
    390398      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
    391399      ! 
    392       IF( kt == nit000 ) tsk(:,:) = sst_m(:,:)*tmask(:,:,1)  ! no previous estimate of skin temperature => using bulk SST 
    393       ! 
     400      !                                            ! compute the surface ocean fluxes using bulk formulea 
    394401      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    395402         CALL blk_oce_1( kt, sf(jp_wndi)%fnow(:,:,1), sf(jp_wndj)%fnow(:,:,1),   &   !   <<= in 
    … …  
    557564         !    (see Josey, Gulev & Yu, 2013) / doi=10.1016/B978-0-12-391851-2.00005-2 
    558565         !    (since reanalysis products provide T at z, not theta !) 
    559          ztpot = ptair(:,:) + gamma_moist( ptair(:,:), zqair(:,:) ) * rn_zqt 
     566         !#LB: because AGRIF hates functions that return something else than a scalar, need to 
     567         !     use scalar version of gamma_moist() ... 
     568         DO jj = 1, jpj 
     569            DO ji = 1, jpi 
     570               ztpot(ji,jj) = ptair(ji,jj) + gamma_moist( ptair(ji,jj), zqair(ji,jj) ) * rn_zqt 
     571            END DO 
     572         END DO 
    560573      ENDIF 
    561574 
    … …  
    598611         ELSEWHERE 
    599612            ! we forget about the update... 
    600             zst(:,:)  = zztmp1(:,:) !LB: using what we backed up before skin-algo 
    601             pssq(:,:) = zztmp2(:,:) !LB:  "   "   " 
     613            zst(:,:)  = zztmp1(:,:) !#LB: using what we backed up before skin-algo 
     614            pssq(:,:) = zztmp2(:,:) !#LB:  "   "   " 
    602615         END WHERE 
    603          tsk(:,:) = zst(:,:) !#LB: Update of tsk, the "official" array for skin temperature 
    604616      END IF 
    605617 
    … …  
    726738      ! ----------------------------- 
    727739 
    728       zqla(:,:) = L_vap( zst(:,:) ) * pevp(:,:) * -1._wp    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 
     740      ! use scalar version of L_vap() for AGRIF compatibility 
     741      DO jj = 1, jpj 
     742         DO ji = 1, jpi 
     743            zqla(ji,jj) = L_vap( zst(ji,jj) ) * pevp(ji,jj) * -1._wp    ! Latent Heat flux !!GS: possibility to add a global qla to avoid recomputation after abl update 
     744         ENDDO 
     745      ENDDO 
    729746 
    730747      IF(ln_ctl) THEN 
    … …  
    755772#endif 
    756773      ! 
    757       CALL iom_put( "rho_air"  ,   rhoa )                 ! output air density (kg/m^3) !#LB 
    758       CALL iom_put( "qlw_oce"  ,   zqlw )                 ! output downward longwave heat over the ocean 
    759       CALL iom_put( "qsb_oce"  ,   psen )                 ! output downward sensible heat over the ocean 
    760       CALL iom_put( "qla_oce"  ,   zqla )                 ! output downward latent   heat over the ocean 
    761       CALL iom_put( "evap_oce" ,   pevp )                 ! evaporation 
    762       CALL iom_put( "qemp_oce" ,   qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
    763       CALL iom_put( "qns_oce"  ,   qns  )                 ! output downward non solar heat over the ocean 
    764       CALL iom_put( "qsr_oce"  ,   qsr  )                 ! output downward solar heat over the ocean 
    765       CALL iom_put( "qt_oce"   ,   qns+qsr )              ! output total downward heat over the ocean 
    766       tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)  ! output total precipitation [kg/m2/s] 
    767       sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)  ! output solid precipitation [kg/m2/s] 
    768       CALL iom_put( 'snowpre', sprecip )                  ! Snow 
    769       CALL iom_put( 'precip' , tprecip )                  ! Total precipitation 
     774      CALL iom_put( "rho_air"  , rhoa*tmask(:,:,1) )       ! output air density [kg/m^3] 
     775      CALL iom_put( "evap_oce" , pevp )                    ! evaporation 
     776      CALL iom_put( "qlw_oce"  , zqlw )                    ! output downward longwave heat over the ocean 
     777      CALL iom_put( "qsb_oce"  , psen )                    ! output downward sensible heat over the ocean 
     778      CALL iom_put( "qla_oce"  , zqla )                    ! output downward latent   heat over the ocean 
     779      tprecip(:,:) = pprec(:,:) * rn_pfac * tmask(:,:,1)   ! output total precipitation [kg/m2/s] 
     780      sprecip(:,:) = psnow(:,:) * rn_pfac * tmask(:,:,1)   ! output solid precipitation [kg/m2/s] 
     781      CALL iom_put( 'snowpre', sprecip )                   ! Snow 
     782      CALL iom_put( 'precip' , tprecip )                   ! Total precipitation 
     783      ! 
     784      IF ( nn_ice == 0 ) THEN 
     785         CALL iom_put( "qemp_oce" , qns-zqlw-psen-zqla )   ! output downward heat content of E-P over the ocean 
     786         CALL iom_put( "qns_oce"  ,   qns  )               ! output downward non solar heat over the ocean 
     787         CALL iom_put( "qsr_oce"  ,   qsr  )               ! output downward solar heat over the ocean 
     788         CALL iom_put( "qt_oce"   ,   qns+qsr )            ! output total downward heat over the ocean 
     789      ENDIF 
     790      ! 
    770791      IF( ln_skin_cs .OR. ln_skin_wl ) THEN 
    771792         CALL iom_put( "t_skin" ,  (zst - rt0) * tmask(:,:,1) )           ! T_skin in Celsius 
    … …  
    12951316            zChn_form_ice = zCdn_form_ice / ( 1._wp + ( LOG( z1_alphaf ) / vkarmn ) * SQRT( zCdn_form_ice ) )               ! Eq. 53 
    12961317 
    1297             ! Momentum and Heat Stability functions (!!GS: possibility to use psi_m_ecmwf instead ?) 
     1318            ! Momentum and Heat Stability functions (possibility to use psi_m_ecmwf instead ?) 
    12981319            z0w = rn_zu * EXP( -1._wp * vkarmn / SQRT( Cdn_oce(ji,jj) ) ) ! over water 
    12991320            z0i = z0_skin_ice                                             ! over ice 
    … …  
    13251346         END DO 
    13261347      END DO 
    1327       ! 
    13281348      CALL lbc_lnk_multi( 'sbcblk', pcd, 'T',  1., pch, 'T', 1. ) 
    13291349      ! 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcblk_algo_ncar.F90

    r12015 r12063  
    2626   USE dom_oce         ! ocean space and time domain 
    2727   USE phycst          ! physical constants 
     28   USE sbc_oce         ! Surface boundary condition: ocean fields 
     29   USE sbcwave, ONLY   :  cdn_wave ! wave module 
     30#if defined key_si3 || defined key_cice 
     31   USE sbc_ice         ! Surface boundary condition: ice fields 
     32#endif 
     33   ! 
    2834   USE iom             ! I/O manager library 
    2935   USE lib_mpp         ! distribued memory computing library 
    3036   USE in_out_manager  ! I/O manager 
    3137   USE prtctl          ! Print control 
    32    USE sbcwave, ONLY   :  cdn_wave ! wave module 
    33 #if defined key_si3 || defined key_cice 
    34    USE sbc_ice         ! Surface boundary condition: ice fields 
    35 #endif 
    3638   USE lib_fortran     ! to use key_nosignedzero 
    3739 
    38    USE sbc_oce         ! Surface boundary condition: ocean fields 
    3940   USE sbcblk_phy      ! all thermodynamics functions, rho_air, q_sat, etc... !LB 
    4041 
    … …  
    5253      &                  Cd, Ch, Ce, t_zu, q_zu, U_blk,      & 
    5354      &                  Cdn, Chn, Cen                       ) 
    54       !!---------------------------------------------------------------------- 
     55      !!---------------------------------------------------------------------------------- 
    5556      !!                      ***  ROUTINE  turb_ncar  *** 
    5657      !! 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbccpl.F90

    r11348 r12063  
    453453      CASE( 'conservative'  ) 
    454454         srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 
    455          IF ( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE. 
     455         IF( k_ice <= 1 )  srcv(jpr_ievp)%laction = .FALSE. 
    456456      CASE( 'oce and ice'   )   ;   srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 
    457457      CASE default              ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) 
    … …  
    557557      srcv(jpr_botm )%clname = 'OBotMlt' 
    558558      IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 
    559          IF ( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
     559         IF( TRIM( sn_rcv_iceflx%clcat ) == 'yes' ) THEN 
    560560            srcv(jpr_topm:jpr_botm)%nct = nn_cats_cpl 
    561561         ELSE 
    … …  
    568568      !                                                      ! ------------------------- ! 
    569569      srcv(jpr_ts_ice)%clname = 'OTsfIce'    ! needed by Met Office 
    570       IF ( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE. 
    571       IF ( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl 
    572       IF ( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl 
     570      IF( TRIM( sn_rcv_ts_ice%cldes ) == 'ice' )   srcv(jpr_ts_ice)%laction = .TRUE. 
     571      IF( TRIM( sn_rcv_ts_ice%clcat ) == 'yes' )   srcv(jpr_ts_ice)%nct     = nn_cats_cpl 
     572      IF( TRIM( sn_rcv_emp%clcat    ) == 'yes' )   srcv(jpr_ievp)%nct       = nn_cats_cpl 
    573573 
    574574      !                                                      ! ------------------------- ! 
    … …  
    692692         ! for example O_Runoff received by OPA from SAS and therefore O_Runoff received by SAS from the Atmosphere 
    693693         DO jn = 1, jprcv 
    694             IF ( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
     694            IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) 
    695695         END DO 
    696696         ! 
    … …  
    719719      ! =================================================== ! 
    720720      DO jn = 1, jprcv 
    721          IF ( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
     721         IF( srcv(jn)%laction ) ALLOCATE( frcv(jn)%z3(jpi,jpj,srcv(jn)%nct) ) 
    722722      END DO 
    723723      ! Allocate taum part of frcv which is used even when not received as coupling field 
    724       IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
     724      IF( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jpr_taum)%nct) ) 
    725725      ! Allocate w10m part of frcv which is used even when not received as coupling field 
    726       IF ( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
     726      IF( .NOT. srcv(jpr_w10m)%laction ) ALLOCATE( frcv(jpr_w10m)%z3(jpi,jpj,srcv(jpr_w10m)%nct) ) 
    727727      ! Allocate jpr_otx1 part of frcv which is used even when not received as coupling field 
    728       IF ( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
    729       IF ( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
     728      IF( .NOT. srcv(jpr_otx1)%laction ) ALLOCATE( frcv(jpr_otx1)%z3(jpi,jpj,srcv(jpr_otx1)%nct) ) 
     729      IF( .NOT. srcv(jpr_oty1)%laction ) ALLOCATE( frcv(jpr_oty1)%z3(jpi,jpj,srcv(jpr_oty1)%nct) ) 
    730730      ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 
    731731      IF( k_ice /= 0 ) THEN 
    732          IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
    733          IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
    734       END IF 
     732         IF( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jpr_itx1)%nct) ) 
     733         IF( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jpr_ity1)%nct) ) 
     734      ENDIF 
    735735 
    736736      ! ================================ ! 
    … …  
    756756      CASE( 'oce and ice' , 'weighted oce and ice' , 'oce and weighted ice' ) 
    757757         ssnd( (/jps_toce, jps_tice/) )%laction = .TRUE. 
    758          IF ( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl 
     758         IF( TRIM( sn_snd_temp%clcat ) == 'yes' )  ssnd(jps_tice)%nct = nn_cats_cpl 
    759759      CASE( 'mixed oce-ice'                        )   ;   ssnd( jps_tmix )%laction = .TRUE. 
    760760      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_temp%cldes' ) 
    … …  
    776776      !     1. sending mixed oce-ice albedo or 
    777777      !     2. receiving mixed oce-ice solar radiation  
    778       IF ( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
     778      IF( TRIM ( sn_snd_alb%cldes ) == 'mixed oce-ice' .OR. TRIM ( sn_rcv_qsr%cldes ) == 'mixed oce-ice' ) THEN 
    779779         CALL oce_alb( zaos, zacs ) 
    780780         ! Due to lack of information on nebulosity : mean clear/overcast sky 
    … …  
    795795         ssnd(jps_fice1)%laction = .TRUE.                 ! First-order regridded ice concentration, to be used producing atmos-to-ice fluxes (Met Office requirement) 
    796796! Currently no namelist entry to determine sending of multi-category ice fraction so use the thickness entry for now 
    797          IF ( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl 
    798          IF ( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
     797         IF( TRIM( sn_snd_thick%clcat  ) == 'yes' ) ssnd(jps_fice)%nct  = nn_cats_cpl 
     798         IF( TRIM( sn_snd_thick1%clcat ) == 'yes' ) ssnd(jps_fice1)%nct = nn_cats_cpl 
    799799      ENDIF 
    800800       
    801       IF (TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
     801      IF(TRIM( sn_snd_ifrac%cldes )  == 'coupled') ssnd(jps_ficet)%laction = .TRUE.  
    802802 
    803803      SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 
    … …  
    805805      CASE( 'ice and snow' )  
    806806         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    807          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
     807         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN 
    808808            ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    809809         ENDIF 
    810810      CASE ( 'weighted ice and snow' )  
    811811         ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 
    812          IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
     812         IF( TRIM( sn_snd_thick%clcat ) == 'yes' ) ssnd(jps_hice:jps_hsnw)%nct = nn_cats_cpl 
    813813      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_thick%cldes' ) 
    814814      END SELECT 
    … …  
    827827         ssnd(jps_a_p)%laction  = .TRUE.  
    828828         ssnd(jps_ht_p)%laction = .TRUE.  
    829          IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
     829         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    830830            ssnd(jps_a_p)%nct  = nn_cats_cpl  
    831831            ssnd(jps_ht_p)%nct = nn_cats_cpl  
    832832         ELSE  
    833             IF ( nn_cats_cpl > 1 ) THEN  
     833            IF( nn_cats_cpl > 1 ) THEN  
    834834               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_mpnd%cldes if not exchanging category fields' )  
    835835            ENDIF  
    … …  
    838838         ssnd(jps_a_p)%laction  = .TRUE.  
    839839         ssnd(jps_ht_p)%laction = .TRUE.  
    840          IF ( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
     840         IF( TRIM( sn_snd_mpnd%clcat ) == 'yes' ) THEN  
    841841            ssnd(jps_a_p)%nct  = nn_cats_cpl   
    842842            ssnd(jps_ht_p)%nct = nn_cats_cpl   
    … …  
    913913      CASE ( 'ice only' )  
    914914         ssnd(jps_ttilyr)%laction = .TRUE.  
    915          IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
     915         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) THEN  
    916916            ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    917917         ELSE  
    918             IF ( nn_cats_cpl > 1 ) THEN  
     918            IF( nn_cats_cpl > 1 ) THEN  
    919919               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_ttilyr%cldes if not exchanging category fields' )  
    920920            ENDIF  
    … …  
    922922      CASE ( 'weighted ice' )  
    923923         ssnd(jps_ttilyr)%laction = .TRUE.  
    924          IF ( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
     924         IF( TRIM( sn_snd_ttilyr%clcat ) == 'yes' ) ssnd(jps_ttilyr)%nct = nn_cats_cpl  
    925925      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_ttilyr%cldes;'//sn_snd_ttilyr%cldes )  
    926926      END SELECT  
    … …  
    932932      CASE ( 'ice only' )  
    933933         ssnd(jps_kice)%laction = .TRUE.  
    934          IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
     934         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) THEN  
    935935            ssnd(jps_kice)%nct = nn_cats_cpl  
    936936         ELSE  
    937             IF ( nn_cats_cpl > 1 ) THEN  
     937            IF( nn_cats_cpl > 1 ) THEN  
    938938               CALL ctl_stop( 'sbc_cpl_init: use weighted ice option for sn_snd_cond%cldes if not exchanging category fields' )  
    939939            ENDIF  
    … …  
    941941      CASE ( 'weighted ice' )  
    942942         ssnd(jps_kice)%laction = .TRUE.  
    943          IF ( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
     943         IF( TRIM( sn_snd_cond%clcat ) == 'yes' ) ssnd(jps_kice)%nct = nn_cats_cpl  
    944944      CASE default   ;   CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_snd_cond%cldes;'//sn_snd_cond%cldes )  
    945945      END SELECT  
    … …  
    10021002         ! for example O_SSTSST sent by OPA to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 
    10031003         DO jn = 1, jpsnd 
    1004             IF ( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
     1004            IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) 
    10051005         END DO 
    10061006         ! 
    … …  
    10291029      CALL cpl_define(jprcv, jpsnd, nn_cplmodel) 
    10301030       
    1031       IF (ln_usecplmask) THEN  
     1031      IF(ln_usecplmask) THEN  
    10321032         xcplmask(:,:,:) = 0. 
    10331033         CALL iom_open( 'cplmask', inum ) 
    … …  
    12651265     
    12661266          IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible)  
    1267       END IF  
     1267      ENDIF  
    12681268      ! 
    12691269      IF( ln_sdw ) THEN  ! Stokes Drift correction activated 
    … …  
    14141414         ELSE IF( srcv(jpr_qnsmix)%laction ) THEN   ;   zqns(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    14151415         ELSE                                       ;   zqns(:,:) = 0._wp 
    1416          END IF 
     1416         ENDIF 
    14171417         ! update qns over the free ocean with: 
    14181418         IF( nn_components /= jp_iam_opa ) THEN 
    … …  
    16861686      ! --- evaporation over ice (kg/m2/s) --- ! 
    16871687      DO jl=1,jpl 
    1688          IF (sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
     1688         IF(sn_rcv_emp%clcat == 'yes') THEN   ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,jl) 
    16891689         ELSE                                  ;   zevap_ice(:,:,jl) = frcv(jpr_ievp)%z3(:,:,1 )   ;   ENDIF 
    16901690      ENDDO 
    … …  
    17851785      CASE( 'conservative' )     ! the required fields are directly provided 
    17861786         zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) 
    1787          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1787         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    17881788            zqns_ice(:,:,1:jpl) = frcv(jpr_qnsice)%z3(:,:,1:jpl) 
    17891789         ELSE 
    … …  
    17941794      CASE( 'oce and ice' )      ! the total flux is computed from ocean and ice fluxes 
    17951795         zqns_tot(:,:) =  ziceld(:,:) * frcv(jpr_qnsoce)%z3(:,:,1) 
    1796          IF ( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
     1796         IF( TRIM(sn_rcv_qns%clcat) == 'yes' ) THEN 
    17971797            DO jl=1,jpl 
    17981798               zqns_tot(:,:   ) = zqns_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qnsice)%z3(:,:,jl)    
    … …  
    18961896#endif 
    18971897      ! outputs 
    1898       IF ( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving 
    1899       IF ( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
    1900       IF ( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
    1901       IF ( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
     1898      IF( srcv(jpr_cal)%laction       ) CALL iom_put('hflx_cal_cea'    , - frcv(jpr_cal)%z3(:,:,1) * rLfus )                      ! latent heat from calving 
     1899      IF( srcv(jpr_icb)%laction       ) CALL iom_put('hflx_icb_cea'    , - frcv(jpr_icb)%z3(:,:,1) * rLfus )                      ! latent heat from icebergs melting 
     1900      IF( iom_use('hflx_rain_cea')    ) CALL iom_put('hflx_rain_cea'   , ( tprecip(:,:) - sprecip(:,:) ) * zcptrain(:,:) )        ! heat flux from rain (cell average) 
     1901      IF( iom_use('hflx_evap_cea')    ) CALL iom_put('hflx_evap_cea'   , ( frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) & 
    19021902           &                                                              * picefr(:,:) ) * zcptn(:,:) * tmask(:,:,1) )            ! heat flux from evap (cell average) 
    1903       IF ( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
    1904       IF ( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
     1903      IF( iom_use('hflx_snow_cea')    ) CALL iom_put('hflx_snow_cea'   , sprecip(:,:) * ( zcptsnw(:,:) - rLfus )  )               ! heat flux from snow (cell average) 
     1904      IF( iom_use('hflx_snow_ao_cea') ) CALL iom_put('hflx_snow_ao_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) & 
    19051905           &                                                              * ( 1._wp - zsnw(:,:) )                  )               ! heat flux from snow (over ocean) 
    1906       IF ( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
     1906      IF( iom_use('hflx_snow_ai_cea') ) CALL iom_put('hflx_snow_ai_cea', sprecip(:,:) * ( zcptsnw(:,:) - rLfus ) &  
    19071907           &                                                              *           zsnw(:,:)                    )               ! heat flux from snow (over ice) 
    19081908      ! note: hflx for runoff and iceshelf are done in sbcrnf and sbcisf resp. 
    … …  
    19151915      CASE( 'conservative' ) 
    19161916         zqsr_tot(:,:  ) = frcv(jpr_qsrmix)%z3(:,:,1) 
    1917          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1917         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    19181918            zqsr_ice(:,:,1:jpl) = frcv(jpr_qsrice)%z3(:,:,1:jpl) 
    19191919         ELSE 
    … …  
    19271927      CASE( 'oce and ice' ) 
    19281928         zqsr_tot(:,:  ) =  ziceld(:,:) * frcv(jpr_qsroce)%z3(:,:,1) 
    1929          IF ( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
     1929         IF( TRIM(sn_rcv_qsr%clcat) == 'yes' ) THEN 
    19301930            DO jl = 1, jpl 
    19311931               zqsr_tot(:,:   ) = zqsr_tot(:,:) + a_i(:,:,jl) * frcv(jpr_qsrice)%z3(:,:,jl)    
    … …  
    19831983      !                                                      ! ========================= ! 
    19841984      CASE ('coupled') 
    1985          IF ( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
     1985         IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 
    19861986            zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 
    19871987         ELSE 
    … …  
    20612061      IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 
    20622062          
    2063          IF ( nn_components == jp_iam_opa ) THEN 
     2063         IF( nn_components == jp_iam_opa ) THEN 
    20642064            ztmp1(:,:) = tsn(:,:,1,jp_tem)   ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 
    20652065         ELSE 
    … …  
    24662466      IF( ssnd(jps_ficet)%laction ) THEN  
    24672467         CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )  
    2468       END IF  
     2468      ENDIF  
    24692469      !                                                      ! ------------------------- !  
    24702470      !                                                      !   Water levels to waves   !  
    … …  
    24812481         ENDIF   
    24822482         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    2483       END IF  
     2483      ENDIF  
    24842484      ! 
    24852485      !  Fields sent by OPA to SAS when doing OPA<->SAS coupling 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcice_cice.F90

    r11348 r12063  
    132132         IF      ( ksbc == jp_flx ) THEN 
    133133            CALL cice_sbc_force(kt) 
    134          ELSE IF ( ksbc == jp_purecpl ) THEN 
     134         ELSE IF( ksbc == jp_purecpl ) THEN 
    135135            CALL sbc_cpl_ice_flx( fr_i ) 
    136136         ENDIF 
    … …  
    140140         CALL cice_sbc_out ( kt, ksbc ) 
    141141 
    142          IF ( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
     142         IF( ksbc == jp_purecpl )  CALL cice_sbc_hadgam(kt+1) 
    143143 
    144144      ENDIF                                          ! End sea-ice time step only 
    … …  
    168168      ! there is no restart file. 
    169169      ! Values from a CICE restart file would overwrite this 
    170       IF ( .NOT. ln_rstart ) THEN     
     170      IF( .NOT. ln_rstart ) THEN     
    171171         CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.)  
    172172      ENDIF   
    … …  
    177177 
    178178! Do some CICE consistency checks 
    179       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    180          IF ( calc_strair .OR. calc_Tsfc ) THEN 
     179      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     180         IF( calc_strair .OR. calc_Tsfc ) THEN 
    181181            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' ) 
    182182         ENDIF 
    183       ELSEIF (ksbc == jp_blk) THEN 
    184          IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
     183      ELSEIF(ksbc == jp_blk) THEN 
     184         IF( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN 
    185185            CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' ) 
    186186         ENDIF 
    … …  
    202202 
    203203      CALL cice2nemo(aice,fr_i, 'T', 1. ) 
    204       IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
     204      IF( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 
    205205         DO jl=1,ncat 
    206206            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    297297! forced and coupled case  
    298298 
    299       IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
     299      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    300300 
    301301         ztmpn(:,:,:)=0.0 
    … …  
    322322 
    323323! Surface downward latent heat flux (CI_5) 
    324          IF (ksbc == jp_flx) THEN 
     324         IF(ksbc == jp_flx) THEN 
    325325            DO jl=1,ncat 
    326326               ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 
    … …  
    332332            DO jj=1,jpj 
    333333               DO ji=1,jpi 
    334                   IF (fr_i(ji,jj).eq.0.0) THEN 
     334                  IF(fr_i(ji,jj).eq.0.0) THEN 
    335335                     DO jl=1,ncat 
    336336                        ztmpn(ji,jj,jl)=0.0 
    … …  
    351351! GBM conductive flux through ice (CI_6) 
    352352!  Convert to GBM 
    353             IF (ksbc == jp_flx) THEN 
     353            IF(ksbc == jp_flx) THEN 
    354354               ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 
    355355            ELSE 
    … …  
    360360! GBM surface heat flux (CI_7) 
    361361!  Convert to GBM 
    362             IF (ksbc == jp_flx) THEN 
     362            IF(ksbc == jp_flx) THEN 
    363363               ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)  
    364364            ELSE 
    … …  
    368368         ENDDO 
    369369 
    370       ELSE IF (ksbc == jp_blk) THEN 
     370      ELSE IF(ksbc == jp_blk) THEN 
    371371 
    372372! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself) 
    … …  
    546546! Freshwater fluxes  
    547547 
    548       IF (ksbc == jp_flx) THEN 
     548      IF(ksbc == jp_flx) THEN 
    549549! Note that emp from the forcing files is evap*(1-aice)-(tprecip-aice*sprecip) 
    550550! What we want here is evap*(1-aice)-tprecip*(1-aice) hence manipulation below 
    … …  
    552552! Better to use evap and tprecip? (but for now don't read in evap in this case) 
    553553         emp(:,:)  = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 
    554       ELSE IF (ksbc == jp_blk) THEN 
     554      ELSE IF(ksbc == jp_blk) THEN 
    555555         emp(:,:)  = (1.0-fr_i(:,:))*emp(:,:)         
    556       ELSE IF (ksbc == jp_purecpl) THEN 
     556      ELSE IF(ksbc == jp_purecpl) THEN 
    557557! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)  
    558558! This is currently as required with the coupling fields from the UM atmosphere 
    … …  
    584584! Scale qsr and qns according to ice fraction (bulk formulae only) 
    585585 
    586       IF (ksbc == jp_blk) THEN 
     586      IF(ksbc == jp_blk) THEN 
    587587         qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:)) 
    588588         qns(:,:)=qns(:,:)*(1.0-fr_i(:,:)) 
    589589      ENDIF 
    590590! Take into account snow melting except for fully coupled when already in qns_tot 
    591       IF (ksbc == jp_purecpl) THEN 
     591      IF(ksbc == jp_purecpl) THEN 
    592592         qsr(:,:)= qsr_tot(:,:) 
    593593         qns(:,:)= qns_tot(:,:) 
    … …  
    624624 
    625625      CALL cice2nemo(aice,fr_i,'T', 1. ) 
    626       IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
     626      IF( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN 
    627627         DO jl=1,ncat 
    628628            CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. ) 
    … …  
    879879!     B. Gather pn into global array (png) 
    880880 
    881       IF ( jpnij > 1) THEN 
     881      IF( jpnij > 1) THEN 
    882882         CALL mppsync 
    883883         CALL mppgather (pn,0,png)  
    … …  
    892892! (may be OK but not 100% sure) 
    893893 
    894       IF (nproc==0) THEN      
     894      IF(nproc==0) THEN      
    895895!        pcg(:,:)=0.0 
    896896         DO jn=1,jpnij 
    … …  
    10151015! the lbclnk call on pn will replace these with sensible values 
    10161016 
    1017       IF (nproc==0) THEN 
     1017      IF(nproc==0) THEN 
    10181018         png(:,:,:)=0.0 
    10191019         DO jn=1,jpnij 
    … …  
    10281028!     C. Scatter png into NEMO field (pn) for each processor 
    10291029 
    1030       IF ( jpnij > 1) THEN 
     1030      IF( jpnij > 1) THEN 
    10311031         CALL mppsync 
    10321032         CALL mppscatter (png,0,pn)  

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcisf.F90

    r11348 r12063  
    303303      ! 
    304304      ! Allocate public variable 
    305       IF ( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' ) 
     305      IF( sbc_isf_alloc()  /= 0 )         CALL ctl_stop( 'STOP', 'sbc_isf : unable to allocate arrays' ) 
    306306      ! 
    307307      ! initialisation 
    … …  
    440440            !! Initialize arrays to 0 (each step) 
    441441            zt_sum = 0.e0_wp 
    442             IF ( ik > 1 ) THEN 
     442            IF( ik > 1 ) THEN 
    443443               ! 1. -----------the average temperature between 200m and 600m --------------------- 
    444444               DO jk = misfkt(ji,jj),misfkb(ji,jj) 
    … …  
    459459            ELSE 
    460460               qisf(ji,jj) = 0._wp   ;   fwfisf(ji,jj) = 0._wp 
    461             END IF 
     461            ENDIF 
    462462         END DO 
    463463      END DO 
    … …  
    496496      ! coeficient for linearisation of potential tfreez 
    497497      ! Crude approximation for pressure (but commonly used) 
    498       IF ( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017) 
     498      IF( l_useCT ) THEN   ! linearisation from Jourdain et al. (2017) 
    499499         zlamb1 =-0.0564_wp 
    500500         zlamb2 = 0.0773_wp 
    … …  
    558558                  ! compute s freeze 
    559559                  zsfrz=(-zbqe-SQRT(zdis))*zaqer 
    560                   IF ( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer 
     560                  IF( zsfrz < 0.0_wp ) zsfrz=(-zbqe+SQRT(zdis))*zaqer 
    561561 
    562562                  ! compute t freeze (eq. 22) 
    … …  
    578578 
    579579         ! define if we need to iterate (nn_gammablk 0/1 do not need iteration) 
    580          IF ( nn_gammablk <  2 ) THEN ; lit = .FALSE. 
     580         IF( nn_gammablk <  2 ) THEN ; lit = .FALSE. 
    581581         ELSE                            
    582582            ! check total number of iteration 
    583             IF (nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
     583            IF(nit >= 100) THEN ; CALL ctl_stop( 'STOP', 'sbc_isf_hol99 : too many iteration ...' ) 
    584584            ELSE                 ; nit = nit + 1 
    585             END IF 
     585            ENDIF 
    586586 
    587587            ! compute error between 2 iterations 
    588588            ! if needed save gammat and compute zhtflx_b for next iteration 
    589589            zerr = MAXVAL(ABS(zhtflx-zhtflx_b)) 
    590             IF ( zerr <= 0.01_wp ) THEN ; lit = .FALSE. 
     590            IF( zerr <= 0.01_wp ) THEN ; lit = .FALSE. 
    591591            ELSE                        ; zhtflx_b(:,:) = zhtflx(:,:) 
    592             END IF 
    593          END IF 
     592            ENDIF 
     593         ENDIF 
    594594      END DO 
    595595      ! 
    … …  
    718718                  pgt(ji,jj) = zustar(ji,jj) / (zgturb + zgmolet) 
    719719                  pgs(ji,jj) = zustar(ji,jj) / (zgturb + zgmoles) 
    720                END IF 
     720               ENDIF 
    721721            END DO 
    722722         END DO 
    … …  
    757757               ! determine the deepest level influenced by the boundary layer 
    758758               DO jk = ikt+1, mbku(ji,jj) 
    759                   IF ( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
     759                  IF( (SUM(e3u_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (umask(ji,jj,jk) == 1) ) ikb = jk 
    760760               END DO 
    761761               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3u_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    789789               ! determine the deepest level influenced by the boundary layer 
    790790               DO jk = ikt+1, mbkv(ji,jj) 
    791                   IF ( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
     791                  IF( (SUM(e3v_n(ji,jj,ikt:jk-1)) < zhisf_tbl(ji,jj)) .AND. (vmask(ji,jj,jk) == 1) ) ikb = jk 
    792792               END DO 
    793793               zhisf_tbl(ji,jj) = MIN(zhisf_tbl(ji,jj), SUM(e3v_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    869869               ! determine the deepest level influenced by the boundary layer 
    870870               DO jk = ikt, mbkt(ji,jj) 
    871                   IF ( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
     871                  IF( (SUM(e3t_n(ji,jj,ikt:jk-1)) .LT. rhisf_tbl(ji,jj)) .AND. (tmask(ji,jj,jk) == 1) ) ikb = jk 
    872872               END DO 
    873873               rhisf_tbl(ji,jj) = MIN(rhisf_tbl(ji,jj), SUM(e3t_n(ji,jj,ikt:ikb)))  ! limit the tbl to water thickness. 
    … …  
    879879            END DO 
    880880         END DO 
    881       END IF  
     881      ENDIF  
    882882      ! 
    883883      !==   ice shelf melting distributed over several levels   ==! 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcmod.F90

    r12015 r12063  
    127127         IF( lk_cice )   nn_ice      = 3 
    128128      ENDIF 
    129 #else 
    130       !IF( lk_si3  )   nn_ice      = 2 
    131       IF( lk_cice )   nn_ice      = 3 
     129!!GS: TBD 
     130!#else 
     131!      IF( lk_si3  )   nn_ice      = 2 
     132!      IF( lk_cice )   nn_ice      = 3 
    132133#endif 
    133134      ! 
    … …  
    250251         fwfisf  (:,:)   = 0._wp   ;   risf_tsc  (:,:,:) = 0._wp 
    251252         fwfisf_b(:,:)   = 0._wp   ;   risf_tsc_b(:,:,:) = 0._wp 
    252       END IF 
     253      ENDIF 
    253254      IF( nn_ice == 0 ) THEN        !* No sea-ice in the domain : ice fraction is always zero 
    254255         IF( nn_components /= jp_iam_opa )   fr_i(:,:) = 0._wp    ! except for OPA in SAS-OPA coupled case 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbcrnf.F90

    r11348 r12063  
    439439         !                                      !    - mixed upstream-centered (ln_traadv_cen2=T) 
    440440         ! 
    441          IF ( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
     441         IF( ln_rnf_depth )   CALL ctl_warn( 'sbc_rnf_init: increased mixing turned on but effects may already',   & 
    442442            &                                              'be spread through depth by ln_rnf_depth'               ) 
    443443         ! 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/sbctide.F90

    r10068 r12063  
    7272         ! Temporarily set nsec_day to beginning of day. 
    7373         nsec_day_orig = nsec_day 
    74          IF ( nsec_day /= NINT(0.5_wp * rdt) ) THEN  
     74         IF( nsec_day /= NINT(0.5_wp * rdt) ) THEN  
    7575            kt_tide = kt - (nsec_day - 0.5_wp * rdt)/rdt 
    7676            nsec_day = NINT(0.5_wp * rdt) 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/SBC/tideini.F90

    r11348 r12063  
    6868      ! 
    6969      IF( ln_tide ) THEN 
    70          IF (lwp) THEN 
     70         IF(lwp) THEN 
    7171            WRITE(numout,*) 
    7272            WRITE(numout,*) 'tide_init : Initialization of the tidal components' 
    … …  
    127127      kt_tide = nit000 
    128128      ! 
    129       IF (.NOT.ln_scal_load ) rn_scal_load = 0._wp 
     129      IF(.NOT.ln_scal_load ) rn_scal_load = 0._wp 
    130130      ! 
    131131   END SUBROUTINE tide_init 

  • NEMO/branches/2019/dev_ASINTER-01-05_merged/src/OCE/TRA/traadv_fct.F90

    r11586 r12063  
    659659         DO ji = fs_2, fs_jpim1 
    660660            ikt = mikt(ji,jj) + 1            ! w-point below the 1st  wet point 
    661             ikb = mbkt(ji,jj)                !     -   above the last wet point 
     661            ikb = MAX(mbkt(ji,jj), 2)        !     -   above the last wet point 
    662662            ! 
    663663            zwd (ji,jj,ikt) = 1._wp          ! top 
Note: See TracChangeset for help on using the changeset viewer.