Changeset 14644 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC
- Timestamp:
- 2021-03-26T15:33:49+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette _wave@13990sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/cpl_oasis3.F90
r14221 r14644 115 115 116 116 !------------------------------------------------------------------ 117 ! 3rd Get an MPI communicator for O PAlocal communication117 ! 3rd Get an MPI communicator for OCE local communication 118 118 !------------------------------------------------------------------ 119 119 … … 294 294 ! 295 295 #if defined key_agrif 296 IF( agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 296 ! Warning: Agrif_Nb_Fine_Grids not yet defined at this stage for Agrif_Root -> must use Agrif_Root_Only() 297 IF( Agrif_Root_Only() .OR. agrif_fixed() == Agrif_Nb_Fine_Grids() ) THEN 297 298 #endif 298 299 CALL oasis_enddef(nerror) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/fldread.F90
r14219 r14644 211 211 ! 212 212 IF( sd(jf)%ln_tint ) THEN ! temporal interpolation 213 IF(lwp .AND. kt - nit000 <= 100) THEN213 IF(lwp .AND. ( kt - nit000 <= 20 .OR. nitend - kt <= 20 ) ) THEN 214 214 clfmt = "(' fld_read: var ', a, ' kt = ', i8, ' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 215 215 & "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" … … 223 223 sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,ibb) + ztinta * sd(jf)%fdta(:,:,:,iaa) 224 224 ELSE ! nothing to do... 225 IF(lwp .AND. kt - nit000 <= 100) THEN225 IF(lwp .AND. ( kt - nit000 <= 20 .OR. nitend - kt <= 20 ) ) THEN 226 226 clfmt = "(' fld_read: var ', a, ' kt = ', i8,' (', f9.4,' days), Y/M/D = ', i4.4,'/', i2.2,'/', i2.2," // & 227 227 & "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" … … 251 251 !!--------------------------------------------------------------------- 252 252 ! 253 IF( nflag == 0 ) nflag = - ( HUGE(0) - 10)253 IF( nflag == 0 ) nflag = -HUGE(0) 254 254 ! 255 255 CALL fld_def( sdjf ) … … 908 908 TYPE(FLD) , INTENT(inout) :: sdjf ! input field related variables 909 909 ! 910 INTEGER , DIMENSION(2):: isave910 INTEGER :: isave 911 911 LOGICAL :: llprev, llnext, llstop 912 912 !!---------------------------------------------------------------------- 913 913 ! 914 914 llprev = sdjf%nrecsec(sdjf%nreclast) < nsec000_1jan000 ! file ends before the beginning of the job -> file may not exist 915 llnext = sdjf%nrecsec( 0) > nsecend_1jan000 ! file begins after the end of the job -> file may not exist915 llnext = sdjf%nrecsec( 1 ) > nsecend_1jan000 ! file begins after the end of the job -> file may not exist 916 916 917 917 llstop = sdjf%ln_clim .OR. .NOT. ( llprev .OR. llnext ) … … 926 926 IF( llprev ) THEN ! previous file does not exist : go back to current and accept to read only the first record 927 927 CALL ctl_warn('previous file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 928 isave(1:2) = sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) ! save previous file info 929 CALL fld_def( sdjf ) ! go back to current file 930 sdjf%nreclast = 1 ! force to use only the first record (do as if other were not existing...) 931 sdjf%nrecsec(0:1) = isave(1:2) 928 isave = sdjf%nrecsec(sdjf%nreclast) ! save previous file info 929 CALL fld_def( sdjf ) ! go back to current file 930 sdjf%nreclast = 1 ! force to use only the first record (do as if other were not existing...) 932 931 ENDIF 933 932 ! 934 933 IF( llnext ) THEN ! next file does not exist : go back to current and accept to read only the last record 935 934 CALL ctl_warn('next file: '//TRIM(sdjf%clname)//' not found -> go back to current year/month/week/day file') 936 isave (1:2) = sdjf%nrecsec(0:1)! save next file info937 CALL fld_def( sdjf ) ! go back to current file938 ! -> read last record but keep record info from the first record of next file939 sdjf%nrecsec(sdjf%nreclast-1:sdjf%nreclast) = isave(1:2)940 sdjf%nrecsec(0:sdjf%nreclast-2) = nflag941 ENDIF935 isave = sdjf%nrecsec(1) ! save next file info 936 CALL fld_def( sdjf ) ! go back to current file 937 ENDIF 938 ! -> read "last" record but keep record info from the first record of next file 939 sdjf%nrecsec( sdjf%nreclast ) = isave 940 sdjf%nrecsec(0:sdjf%nreclast-1) = nflag 942 941 ! 943 942 CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN_TRIM(sdjf%wgtname) > 0 ) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/geo2ocean.F90
r14219 r14644 161 161 ! (computation done on the north stereographic polar plane) 162 162 ! 163 DO_2D( 0, 0, 0, 1)163 DO_2D( 0, 1, 0, 0 ) 164 164 ! 165 165 zlam = plamt(ji,jj) ! north pole direction & modulous (at t-point) … … 250 250 ! =============== ! 251 251 252 DO_2D( 0, 0, 0, 1)252 DO_2D( 0, 1, 0, 0 ) 253 253 IF( MOD( ABS( plamv(ji,jj) - plamv(ji,jj-1) ), 360. ) < 1.e-8 ) THEN 254 254 gsint(ji,jj) = 0. … … 273 273 ! =========================== ! 274 274 ! ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 275 CALL lbc_lnk _multi( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, &276 &gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp )275 CALL lbc_lnk( 'geo2ocean', gcost, 'T', -1.0_wp, gsint, 'T', -1.0_wp, gcosu, 'U', -1.0_wp, gsinu, 'U', -1.0_wp, & 276 & gcosv, 'V', -1.0_wp, gsinv, 'V', -1.0_wp, gcosf, 'F', -1.0_wp, gsinf, 'F', -1.0_wp ) 277 277 ! 278 278 END SUBROUTINE angle -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbc_oce.F90
r14072 r14644 87 87 INTEGER , PUBLIC, PARAMETER :: jp_abl = 4 !: Atmospheric boundary layer formulation 88 88 INTEGER , PUBLIC, PARAMETER :: jp_purecpl = 5 !: Pure ocean-atmosphere Coupled formulation 89 INTEGER , PUBLIC, PARAMETER :: jp_none = 6 !: for O PAwhen doing coupling via SAS module89 INTEGER , PUBLIC, PARAMETER :: jp_none = 6 !: for OCE when doing coupling via SAS module 90 90 ! 91 91 !!---------------------------------------------------------------------- … … 94 94 INTEGER , PUBLIC, PARAMETER :: jp_iam_nemo = 0 !: Initial single executable configuration 95 95 ! (no internal OASIS coupling) 96 INTEGER , PUBLIC, PARAMETER :: jp_iam_o pa = 1 !: Multi executable configuration - OPAcomponent96 INTEGER , PUBLIC, PARAMETER :: jp_iam_oce = 1 !: Multi executable configuration - OCE component 97 97 ! (internal OASIS coupling) 98 98 INTEGER , PUBLIC, PARAMETER :: jp_iam_sas = 2 !: Multi executable configuration - SAS component -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcblk.F90
r14219 r14644 40 40 USE sbcdcy ! surface boundary condition: diurnal cycle 41 41 USE sbcwave , ONLY : cdn_wave ! wave module 42 USE lib_fortran ! to use key_nosignedzero 42 USE lib_fortran ! to use key_nosignedzero and glob_sum 43 43 ! 44 44 #if defined key_si3 … … 348 348 ! !- fill the bulk structure with namelist informations 349 349 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 350 sf(jp_wndi )%zsgn = -1._wp ; sf(jp_wndj )%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 351 sf(jp_uoatm)%zsgn = -1._wp ; sf(jp_voatm)%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 352 sf(jp_hpgi )%zsgn = -1._wp ; sf(jp_hpgj )%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 350 353 ! 351 354 DO jfpr= 1, jpfld … … 501 504 !!---------------------------------------------------------------------- 502 505 REAL(wp), DIMENSION(jpi,jpj) :: zssq, zcd_du, zsen, zlat, zevp 503 REAL(wp) :: ztmp 506 REAL(wp) :: ztst 507 LOGICAL :: llerr 504 508 !!---------------------------------------------------------------------- 505 509 ! … … 508 512 ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 509 513 IF( kt == nit000 ) THEN 510 IF(lwp) WRITE(numout,*) '' 511 #if defined key_agrif 512 IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 513 #else 514 ztmp = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 515 IF( ztmp > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 516 ztmp = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztmp ! mean humidity over ocean on proc 517 SELECT CASE( nhumi ) 518 CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 519 IF( (ztmp < 0._wp) .OR. (ztmp > 0.065) ) ztmp = -1._wp 520 CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 521 IF( (ztmp < 110._wp).OR.(ztmp > 320._wp) ) ztmp = -1._wp 522 CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 523 IF( (ztmp < 0._wp) .OR.(ztmp > 100._wp) ) ztmp = -1._wp 524 END SELECT 525 IF(ztmp < 0._wp) THEN 526 IF (lwp) WRITE(numout,'(" Mean humidity value found on proc #",i6.6," is: ",f10.5)') narea, ztmp 527 CALL ctl_stop( 'STOP', 'Something is wrong with air humidity!!!', & 528 & ' ==> check the unit in your input files' , & 529 & ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 530 & ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 531 END IF 532 END IF 533 IF(lwp) WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 534 #endif 535 IF(lwp) WRITE(numout,*) '' 536 END IF !IF( kt == nit000 ) 514 ! mean humidity over ocean on proc 515 ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(:,:) * tmask(:,:,1) ) / glob_sum( 'sbcblk', e1e2t(:,:) * tmask(:,:,1) ) 516 llerr = .FALSE. 517 SELECT CASE( nhumi ) 518 CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 519 IF( (ztst < 0._wp) .OR. (ztst > 0.065_wp) ) llerr = .TRUE. 520 CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 521 IF( (ztst < 110._wp) .OR. (ztst > 320._wp) ) llerr = .TRUE. 522 CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 523 IF( (ztst < 0._wp) .OR. (ztst > 100._wp) ) llerr = .TRUE. 524 END SELECT 525 IF(llerr) THEN 526 WRITE(ctmp1,'(" Error on mean humidity value: ",f10.5)') ztst 527 CALL ctl_stop( 'STOP', ctmp1, 'Something is wrong with air humidity!!!', & 528 & ' ==> check the unit in your input files' , & 529 & ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 530 & ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 531 ENDIF 532 IF(lwp) THEN 533 WRITE(numout,*) '' 534 WRITE(numout,*) ' Global mean humidity at kt = nit000: ', ztst 535 WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 536 WRITE(numout,*) '' 537 ENDIF 538 ENDIF !IF( kt == nit000 ) 537 539 ! ! compute the surface ocean fluxes using bulk formulea 538 540 IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN … … 620 622 !!--------------------------------------------------------------------- 621 623 INTEGER , INTENT(in ) :: kt ! time step index 622 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at U-point [m/s]623 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at V-point [m/s]624 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndi ! atmospheric wind at T-point [m/s] 625 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pwndj ! atmospheric wind at T-point [m/s] 624 626 REAL(wp), INTENT(in ), DIMENSION(:,:) :: pqair ! specific humidity at T-points [kg/kg] 625 627 REAL(wp), INTENT(in ), DIMENSION(:,:) :: ptair ! potential temperature at T-points [Kelvin] … … 830 832 831 833 IF( ln_crt_fbk ) THEN 832 CALL lbc_lnk _multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', -1._wp )834 CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', 1._wp ) 833 835 ELSE 834 CALL lbc_lnk _multi( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp )836 CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 835 837 ENDIF 836 838 … … 1066 1068 pvtaui(ji,jj) = zztmp2 * ( pvtaui(ji,jj) + pvtaui(ji ,jj+1) ) 1067 1069 END_2D 1068 CALL lbc_lnk _multi( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp )1070 CALL lbc_lnk( 'sbcblk', putaui, 'U', -1._wp, pvtaui, 'V', -1._wp ) 1069 1071 ! 1070 1072 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab2d_1=putaui , clinfo1=' blk_ice: putaui : ' & -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbccpl.F90
r14219 r14644 129 129 INTEGER, PARAMETER :: jpr_icb = 61 130 130 INTEGER, PARAMETER :: jpr_ts_ice = 62 ! Sea ice surface temp 131 !!INTEGER, PARAMETER :: jpr_qtrice = 63 ! Transmitted solar thru sea-ice 131 132 132 133 INTEGER, PARAMETER :: jprcv = 62 ! total number of fields received … … 157 158 INTEGER, PARAMETER :: jps_rnf = 24 ! runoffs 158 159 INTEGER, PARAMETER :: jps_taum = 25 ! wind stress module 159 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to O PA (by SAS when doing SAS-OPAcoupling)160 INTEGER, PARAMETER :: jps_fice2 = 26 ! ice fraction sent to OCE (by SAS when doing SAS-OCE coupling) 160 161 INTEGER, PARAMETER :: jps_e3t1st = 27 ! first level depth (vvl) 161 162 INTEGER, PARAMETER :: jps_fraqsr = 28 ! fraction of solar net radiation absorbed in the first ocean level … … 202 203 & sn_rcv_wstrf, sn_rcv_wdrag, sn_rcv_charn, sn_rcv_taw, sn_rcv_bhd, sn_rcv_tusd, sn_rcv_tvsd 203 204 ! ! Other namelist parameters 205 !! TYPE(FLD_C) :: sn_rcv_qtrice 204 206 INTEGER :: nn_cplmodel ! Maximum number of models to/from which NEMO is potentialy sending/receiving data 205 207 LOGICAL :: ln_usecplmask ! use a coupling mask file to merge data received from several models … … 238 240 !! *** FUNCTION sbc_cpl_alloc *** 239 241 !!---------------------------------------------------------------------- 240 INTEGER :: ierr( 5)242 INTEGER :: ierr(4) 241 243 !!---------------------------------------------------------------------- 242 244 ierr(:) = 0 … … 248 250 #endif 249 251 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 250 #if defined key_si3 || defined key_cice 251 ALLOCATE( a_i_last_couple(jpi,jpj,jpl) , STAT=ierr(4) ) 252 #endif 253 ! 254 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(5) ) 252 ! 253 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) 255 254 256 255 sbc_cpl_alloc = MAXVAL( ierr ) … … 287 286 & sn_rcv_charn , sn_rcv_taw , sn_rcv_bhd , sn_rcv_tusd , sn_rcv_tvsd, & 288 287 & sn_rcv_wdrag , sn_rcv_qns , sn_rcv_emp , sn_rcv_rnf , sn_rcv_cal , & 289 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice 288 & sn_rcv_iceflx, sn_rcv_co2 , sn_rcv_icb , sn_rcv_isf , sn_rcv_ts_ice !!, sn_rcv_qtrice 290 289 291 290 !!--------------------------------------------------------------------- … … 328 327 WRITE(numout,*)' ice shelf = ', TRIM(sn_rcv_isf%cldes ), ' (', TRIM(sn_rcv_isf%clcat ), ')' 329 328 WRITE(numout,*)' sea ice heat fluxes = ', TRIM(sn_rcv_iceflx%cldes), ' (', TRIM(sn_rcv_iceflx%clcat), ')' 329 !! WRITE(numout,*)' transmitted solar thru sea-ice = ', TRIM(sn_rcv_qtrice%cldes), ' (', TRIM(sn_rcv_qtrice%clcat), ')' 330 330 WRITE(numout,*)' atm co2 = ', TRIM(sn_rcv_co2%cldes ), ' (', TRIM(sn_rcv_co2%clcat ), ')' 331 331 WRITE(numout,*)' Sea ice surface skin temperature= ', TRIM(sn_rcv_ts_ice%cldes), ' (', TRIM(sn_rcv_ts_ice%clcat), ')' … … 603 603 srcv(jpr_mslp)%clname = 'O_MSLP' ; IF( TRIM(sn_rcv_mslp%cldes ) == 'coupled' ) srcv(jpr_mslp)%laction = .TRUE. 604 604 ! 605 ! ! ------------------------- !606 ! ! ice topmelt and botmelt !607 ! ! ------------------------- !605 ! ! --------------------------------- ! 606 ! ! ice topmelt and conduction flux ! 607 ! ! --------------------------------- ! 608 608 srcv(jpr_topm )%clname = 'OTopMlt' 609 609 srcv(jpr_botm )%clname = 'OBotMlt' … … 616 616 srcv(jpr_topm:jpr_botm)%laction = .TRUE. 617 617 ENDIF 618 !! ! ! --------------------------- ! 619 !! ! ! transmitted solar thru ice ! 620 !! ! ! --------------------------- ! 621 !! srcv(jpr_qtrice)%clname = 'OQtr' 622 !! IF( TRIM(sn_rcv_qtrice%cldes) == 'coupled' ) THEN 623 !! IF ( TRIM( sn_rcv_qtrice%clcat ) == 'yes' ) THEN 624 !! srcv(jpr_qtrice)%nct = nn_cats_cpl 625 !! ELSE 626 !! CALL ctl_stop( 'sbc_cpl_init: sn_rcv_qtrice%clcat should always be set to yes currently' ) 627 !! ENDIF 628 !! srcv(jpr_qtrice)%laction = .TRUE. 629 !! ENDIF 618 630 ! ! ------------------------- ! 619 631 ! ! ice skin temperature ! … … 707 719 ! 708 720 ! ! ------------------------------- ! 709 ! ! O PA-SAS coupling - rcv by opa !721 ! ! OCE-SAS coupling - rcv by opa ! 710 722 ! ! ------------------------------- ! 711 723 srcv(jpr_sflx)%clname = 'O_SFLX' 712 724 srcv(jpr_fice)%clname = 'RIceFrc' 713 725 ! 714 IF( nn_components == jp_iam_o pa ) THEN ! OPA coupled to SAS via OASIS: force received field by OPA(sent by SAS)726 IF( nn_components == jp_iam_oce ) THEN ! OCE coupled to SAS via OASIS: force received field by OCE (sent by SAS) 715 727 srcv(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 716 728 srcv(:)%clgrid = 'T' ! force default definition in case of opa <-> sas coupling … … 728 740 IF(lwp) THEN ! control print 729 741 WRITE(numout,*) 730 WRITE(numout,*)' Special conditions for SAS-O PAcoupling '731 WRITE(numout,*)' O PAcomponent '742 WRITE(numout,*)' Special conditions for SAS-OCE coupling ' 743 WRITE(numout,*)' OCE component ' 732 744 WRITE(numout,*) 733 745 WRITE(numout,*)' received fields from SAS component ' … … 743 755 ENDIF 744 756 ! ! -------------------------------- ! 745 ! ! O PA-SAS coupling - rcv by sas !757 ! ! OCE-SAS coupling - rcv by sas ! 746 758 ! ! -------------------------------- ! 747 759 srcv(jpr_toce )%clname = 'I_SSTSST' … … 763 775 ! Vectors: change of sign at north fold ONLY if on the local grid 764 776 srcv(jpr_ocx1:jpr_ocy1)%nsgn = -1. 765 ! Change first letter to couple with atmosphere if already coupled O PA777 ! Change first letter to couple with atmosphere if already coupled OCE 766 778 ! this is nedeed as each variable name used in the namcouple must be unique: 767 ! for example O_Runoff received by O PAfrom SAS and therefore S_Runoff received by SAS from the Atmosphere779 ! for example O_Runoff received by OCE from SAS and therefore S_Runoff received by SAS from the Atmosphere 768 780 DO jn = 1, jprcv 769 781 IF( srcv(jn)%clname(1:1) == "O" ) srcv(jn)%clname = "S"//srcv(jn)%clname(2:LEN(srcv(jn)%clname)) … … 772 784 IF(lwp) THEN ! control print 773 785 WRITE(numout,*) 774 WRITE(numout,*)' Special conditions for SAS-O PAcoupling '786 WRITE(numout,*)' Special conditions for SAS-OCE coupling ' 775 787 WRITE(numout,*)' SAS component ' 776 788 WRITE(numout,*) 777 789 IF( .NOT. ln_cpl ) THEN 778 WRITE(numout,*)' received fields from O PAcomponent '790 WRITE(numout,*)' received fields from OCE component ' 779 791 ELSE 780 WRITE(numout,*)' Additional received fields from O PAcomponent : '792 WRITE(numout,*)' Additional received fields from OCE component : ' 781 793 ENDIF 782 794 WRITE(numout,*)' sea surface temperature (Celsius) ' … … 889 901 END SELECT 890 902 891 ! Initialise ice fractions from last coupling time to zero (needed by Met-Office)892 #if defined key_si3 || defined key_cice893 a_i_last_couple(:,:,:) = 0._wp894 #endif895 903 ! ! ------------------------- ! 896 904 ! ! Ice Meltponds ! … … 1029 1037 1030 1038 ! ! ------------------------------- ! 1031 ! ! O PA-SAS coupling - snd by opa !1039 ! ! OCE-SAS coupling - snd by opa ! 1032 1040 ! ! ------------------------------- ! 1033 1041 ssnd(jps_ssh )%clname = 'O_SSHght' … … 1036 1044 ssnd(jps_fraqsr)%clname = 'O_FraQsr' 1037 1045 ! 1038 IF( nn_components == jp_iam_o pa) THEN1046 IF( nn_components == jp_iam_oce ) THEN 1039 1047 ssnd(:)%laction = .FALSE. ! force default definition in case of opa <-> sas coupling 1040 1048 ssnd( (/jps_toce, jps_soce, jps_ssh, jps_fraqsr, jps_ocx1, jps_ocy1/) )%laction = .TRUE. … … 1060 1068 ENDIF 1061 1069 ! ! ------------------------------- ! 1062 ! ! O PA-SAS coupling - snd by sas !1070 ! ! OCE-SAS coupling - snd by sas ! 1063 1071 ! ! ------------------------------- ! 1064 1072 ssnd(jps_sflx )%clname = 'I_SFLX' … … 1078 1086 ! Change first letter to couple with atmosphere if already coupled with sea_ice 1079 1087 ! this is nedeed as each variable name used in the namcouple must be unique: 1080 ! for example O_SSTSST sent by O PAto SAS and therefore S_SSTSST sent by SAS to the Atmosphere1088 ! for example O_SSTSST sent by OCE to SAS and therefore S_SSTSST sent by SAS to the Atmosphere 1081 1089 DO jn = 1, jpsnd 1082 1090 IF( ssnd(jn)%clname(1:1) == "O" ) ssnd(jn)%clname = "S"//ssnd(jn)%clname(2:LEN(ssnd(jn)%clname)) … … 1086 1094 WRITE(numout,*) 1087 1095 IF( .NOT. ln_cpl ) THEN 1088 WRITE(numout,*)' sent fields to O PAcomponent '1096 WRITE(numout,*)' sent fields to OCE component ' 1089 1097 ELSE 1090 WRITE(numout,*)' Additional sent fields to O PAcomponent : '1098 WRITE(numout,*)' Additional sent fields to OCE component : ' 1091 1099 ENDIF 1092 1100 WRITE(numout,*)' ice cover ' … … 1249 1257 frcv(jpr_oty1)%z3(ji,jj,1) = 0.5 * ( frcv(jpr_oty1)%z3(ji ,jj+1,1) + frcv(jpr_oty1)%z3(ji,jj,1) ) 1250 1258 END_2D 1251 CALL lbc_lnk _multi( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp )1259 CALL lbc_lnk( 'sbccpl', frcv(jpr_otx1)%z3(:,:,1), 'U', -1.0_wp, frcv(jpr_oty1)%z3(:,:,1), 'V', -1.0_wp ) 1252 1260 ENDIF 1253 1261 llnewtx = .TRUE. … … 1526 1534 ENDIF 1527 1535 ! update qns over the free ocean with: 1528 IF( nn_components /= jp_iam_o pa) THEN1536 IF( nn_components /= jp_iam_oce ) THEN 1529 1537 zqns(:,:) = zqns(:,:) - zemp(:,:) * sst_m(:,:) * rcp ! remove heat content due to mass flux (assumed to be at SST) 1530 1538 IF( srcv(jpr_snow )%laction ) THEN … … 1590 1598 !! ** Action : return ptau_i, ptau_j, the stress over the ice 1591 1599 !!---------------------------------------------------------------------- 1592 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2]1593 REAL(wp), INTENT( out), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid)1600 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_taui ! i- & j-components of atmos-ice stress [N/m2] 1601 REAL(wp), INTENT(inout), DIMENSION(:,:) :: p_tauj ! at I-point (B-grid) or U & V-point (C-grid) 1594 1602 !! 1595 1603 INTEGER :: ji, jj ! dummy loop indices … … 1598 1606 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty 1599 1607 !!---------------------------------------------------------------------- 1608 ! 1609 #if defined key_si3 || defined key_cice 1600 1610 ! 1601 1611 IF( srcv(jpr_itx1)%laction ) THEN ; itx = jpr_itx1 … … 1667 1677 p_tauj(ji,jj) = zztmp2 * ( frcv(jpr_ity1)%z3(ji ,jj+1,1) + frcv(jpr_ity1)%z3(ji,jj,1) ) 1668 1678 END_2D 1679 <<<<<<< .working 1669 1680 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1._wp, p_tauj, 'V', -1._wp ) 1681 ||||||| .merge-left.r14199 1682 CALL lbc_lnk_multi( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1683 ======= 1684 CALL lbc_lnk( 'sbccpl', p_taui, 'U', -1., p_tauj, 'V', -1. ) 1685 >>>>>>> .merge-right.r14642 1670 1686 END SELECT 1671 1687 1672 1688 ENDIF 1673 1689 ! 1690 #endif 1691 ! 1674 1692 END SUBROUTINE sbc_cpl_ice_tau 1675 1693 1676 1694 1677 SUBROUTINE sbc_cpl_ice_flx( picefr, palbi, psst, pist, phs, phi )1695 SUBROUTINE sbc_cpl_ice_flx( kt, picefr, palbi, psst, pist, phs, phi ) 1678 1696 !!---------------------------------------------------------------------- 1679 1697 !! *** ROUTINE sbc_cpl_ice_flx *** … … 1717 1735 !! are provided but not included in emp here. Only runoff will 1718 1736 !! be included in emp in other parts of NEMO code 1737 !! 1738 !! ** Note : In case of the ice-atm coupling with conduction fluxes (such as Jules interface for the Met-Office), 1739 !! qsr_ice and qns_ice are not provided and they are not supposed to be used in the ice code. 1740 !! However, by precaution we also "fake" qns_ice and qsr_ice this way: 1741 !! qns_ice = qml_ice + qcn_ice ?? 1742 !! qsr_ice = qtr_ice_top ?? 1743 !! 1719 1744 !! ** Action : update at each nf_ice time step: 1720 1745 !! qns_tot, qsr_tot non-solar and solar total heat fluxes … … 1725 1750 !! sprecip solid precipitation over the ocean 1726 1751 !!---------------------------------------------------------------------- 1752 INTEGER, INTENT(in) :: kt ! ocean model time step index (only for a_i_last_couple) 1727 1753 REAL(wp), INTENT(in) , DIMENSION(:,:) :: picefr ! ice fraction [0 to 1] 1728 1754 ! !! ! optional arguments, used only in 'mixed oce-ice' case or for Met-Office coupling … … 1741 1767 REAL(wp), DIMENSION(jpi,jpj) :: ztri 1742 1768 !!---------------------------------------------------------------------- 1769 ! 1770 #if defined key_si3 || defined key_cice 1771 ! 1772 IF( kt == nit000 ) THEN 1773 ! allocate ice fractions from last coupling time here and not in sbc_cpl_init because of jpl 1774 IF( .NOT.ALLOCATED(a_i_last_couple) ) ALLOCATE( a_i_last_couple(jpi,jpj,jpl) ) 1775 ! initialize to a_i for the 1st time step 1776 a_i_last_couple(:,:,:) = a_i(:,:,:) 1777 ENDIF 1743 1778 ! 1744 1779 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1768 1803 CALL ctl_stop('STOP', 'sbccpl/sbc_cpl_ice_flx: some fields are not defined. Change sn_rcv_emp value in namelist namsbc_cpl') 1769 1804 END SELECT 1770 1771 #if defined key_si31772 1805 1773 1806 ! --- evaporation over ice (kg/m2/s) --- ! … … 1861 1894 ENDIF 1862 1895 1863 #else 1864 zsnw(:,:) = picefr(:,:) 1865 ! --- Continental fluxes --- ! 1866 IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1867 rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1868 ENDIF 1869 IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1870 zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1871 ENDIF 1872 IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1873 fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1874 rnf(:,:) = rnf(:,:) + fwficb(:,:) 1875 ENDIF 1876 IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1877 fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1878 ENDIF 1879 ! 1880 IF( ln_mixcpl ) THEN 1881 emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1882 emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1883 sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1884 tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1885 ELSE 1886 emp_tot(:,:) = zemp_tot(:,:) 1887 emp_ice(:,:) = zemp_ice(:,:) 1888 sprecip(:,:) = zsprecip(:,:) 1889 tprecip(:,:) = ztprecip(:,:) 1890 ENDIF 1891 ! 1892 #endif 1893 1896 !! for CICE ?? 1897 !!$ zsnw(:,:) = picefr(:,:) 1898 !!$ ! --- Continental fluxes --- ! 1899 !!$ IF( srcv(jpr_rnf)%laction ) THEN ! runoffs (included in emp later on) 1900 !!$ rnf(:,:) = frcv(jpr_rnf)%z3(:,:,1) 1901 !!$ ENDIF 1902 !!$ IF( srcv(jpr_cal)%laction ) THEN ! calving (put in emp_tot) 1903 !!$ zemp_tot(:,:) = zemp_tot(:,:) - frcv(jpr_cal)%z3(:,:,1) 1904 !!$ ENDIF 1905 !!$ IF( srcv(jpr_icb)%laction ) THEN ! iceberg added to runoffs 1906 !!$ fwficb(:,:) = frcv(jpr_icb)%z3(:,:,1) 1907 !!$ rnf(:,:) = rnf(:,:) + fwficb(:,:) 1908 !!$ ENDIF 1909 !!$ IF( srcv(jpr_isf)%laction ) THEN ! iceshelf (fwfisf <0 mean melting) 1910 !!$ fwfisf_oasis(:,:) = - frcv(jpr_isf)%z3(:,:,1) 1911 !!$ ENDIF 1912 !!$ ! 1913 !!$ IF( ln_mixcpl ) THEN 1914 !!$ emp_tot(:,:) = emp_tot(:,:) * xcplmask(:,:,0) + zemp_tot(:,:) * zmsk(:,:) 1915 !!$ emp_ice(:,:) = emp_ice(:,:) * xcplmask(:,:,0) + zemp_ice(:,:) * zmsk(:,:) 1916 !!$ sprecip(:,:) = sprecip(:,:) * xcplmask(:,:,0) + zsprecip(:,:) * zmsk(:,:) 1917 !!$ tprecip(:,:) = tprecip(:,:) * xcplmask(:,:,0) + ztprecip(:,:) * zmsk(:,:) 1918 !!$ ELSE 1919 !!$ emp_tot(:,:) = zemp_tot(:,:) 1920 !!$ emp_ice(:,:) = zemp_ice(:,:) 1921 !!$ sprecip(:,:) = zsprecip(:,:) 1922 !!$ tprecip(:,:) = ztprecip(:,:) 1923 !!$ ENDIF 1924 ! 1894 1925 ! outputs 1895 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff1896 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf1897 1926 IF( srcv(jpr_cal)%laction ) CALL iom_put( 'calving_cea' , frcv(jpr_cal)%z3(:,:,1) * tmask(:,:,1) ) ! calving 1898 1927 IF( srcv(jpr_icb)%laction ) CALL iom_put( 'iceberg_cea' , frcv(jpr_icb)%z3(:,:,1) * tmask(:,:,1) ) ! icebergs … … 1907 1936 & - frcv(jpr_ievp)%z3(:,:,1) * picefr(:,:) ) * tmask(:,:,1) ) ! ice-free oce evap (cell average) 1908 1937 ! note: runoff output is done in sbcrnf (which includes icebergs too) and iceshelf output is done in sbcisf 1938 !! IF( srcv(jpr_rnf)%laction ) CALL iom_put( 'runoffs' , rnf(:,:) * tmask(:,:,1) ) ! runoff 1939 !! IF( srcv(jpr_isf)%laction ) CALL iom_put( 'iceshelf_cea', -fwfisf(:,:) * tmask(:,:,1) ) ! iceshelf 1940 ! 1941 ! ! ========================= ! 1942 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! 1943 ! ! ========================= ! 1944 CASE ('coupled') 1945 IF (ln_scale_ice_flux) THEN 1946 WHERE( a_i(:,:,:) > 1.e-10_wp ) 1947 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1948 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 1949 ELSEWHERE 1950 qml_ice(:,:,:) = 0.0_wp 1951 qcn_ice(:,:,:) = 0.0_wp 1952 END WHERE 1953 ELSE 1954 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) 1955 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) 1956 ENDIF 1957 END SELECT 1909 1958 ! 1910 1959 ! ! ========================= ! … … 1912 1961 ! ! ========================= ! 1913 1962 CASE( 'oce only' ) ! the required field is directly provided 1914 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) 1915 ! For Met Office sea ice non-solar fluxes are already delt with by JULES so setting to zero 1916 ! here so the only flux is the ocean only one. 1917 zqns_ice(:,:,:) = 0._wp 1963 ! Get the sea ice non solar heat flux from conductive, melting and sublimation fluxes 1964 IF( TRIM(sn_rcv_iceflx%cldes) == 'coupled' ) THEN 1965 zqns_ice(:,:,:) = qml_ice(:,:,:) + qcn_ice(:,:,:) 1966 ELSE 1967 zqns_ice(:,:,:) = 0._wp 1968 ENDIF 1969 ! Calculate the total non solar heat flux. The ocean only non solar heat flux (zqns_oce) will be recalculated after this CASE 1970 ! statement to be consistent with other coupling methods even though .zqns_oce = frcv(jpr_qnsoce)%z3(:,:,1) 1971 zqns_tot(:,:) = frcv(jpr_qnsoce)%z3(:,:,1) + SUM( zqns_ice(:,:,:) * a_i(:,:,:), dim=3 ) 1918 1972 CASE( 'conservative' ) ! the required fields are directly provided 1919 1973 zqns_tot(:,:) = frcv(jpr_qnsmix)%z3(:,:,1) … … 1962 2016 IF( srcv(jpr_icb)%laction ) zqns_tot(:,:) = zqns_tot(:,:) - frcv(jpr_icb)%z3(:,:,1) * rLfus ! remove latent heat of iceberg melting 1963 2017 1964 #if defined key_si31965 2018 ! --- non solar flux over ocean --- ! 1966 2019 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax … … 2015 2068 ENDIF 2016 2069 2017 #else 2018 zcptsnw (:,:) = zcptn(:,:) 2019 zcptrain(:,:) = zcptn(:,:)2020 2021 ! clem: this formulation is certainly wrong... but better than it was... 2022 zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2023 & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2024 & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2025 & - zemp_ice(:,:) ) * zcptn(:,:)2026 2027 IF( ln_mixcpl ) THEN 2028 qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2029 qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2030 DO jl=1,jpl 2031 qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2032 ENDDO 2033 ELSE 2034 qns_tot(:,: ) = zqns_tot(:,: ) 2035 qns_ice(:,:,:) = zqns_ice(:,:,:)2036 ENDIF 2037 2038 #endif 2070 !! for CICE ?? 2071 !!$ ! --- non solar flux over ocean --- ! 2072 !!$ zcptsnw (:,:) = zcptn(:,:) 2073 !!$ zcptrain(:,:) = zcptn(:,:) 2074 !!$ 2075 !!$ ! clem: this formulation is certainly wrong... but better than it was... 2076 !!$ zqns_tot(:,:) = zqns_tot(:,:) & ! zqns_tot update over free ocean with: 2077 !!$ & - ( ziceld(:,:) * zsprecip(:,:) * rLfus ) & ! remove the latent heat flux of solid precip. melting 2078 !!$ & - ( zemp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 2079 !!$ & - zemp_ice(:,:) ) * zcptn(:,:) 2080 !!$ 2081 !!$ IF( ln_mixcpl ) THEN 2082 !!$ qns_tot(:,:) = qns(:,:) * ziceld(:,:) + SUM( qns_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2083 !!$ qns_tot(:,:) = qns_tot(:,:) * xcplmask(:,:,0) + zqns_tot(:,:)* zmsk(:,:) 2084 !!$ DO jl=1,jpl 2085 !!$ qns_ice(:,:,jl) = qns_ice(:,:,jl) * xcplmask(:,:,0) + zqns_ice(:,:,jl)* zmsk(:,:) 2086 !!$ ENDDO 2087 !!$ ELSE 2088 !!$ qns_tot(:,: ) = zqns_tot(:,: ) 2089 !!$ qns_ice(:,:,:) = zqns_ice(:,:,:) 2090 !!$ ENDIF 2091 2039 2092 ! outputs 2040 2093 IF ( srcv(jpr_cal)%laction ) CALL iom_put('hflx_cal_cea' , - frcv(jpr_cal)%z3(:,:,1) * rLfus ) ! latent heat from calving … … 2057 2110 ! 2058 2111 ! ! ========================= ! 2112 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt ! 2113 ! ! ========================= ! 2114 CASE ('coupled') 2115 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN 2116 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl) 2117 ELSE 2118 ! Set all category values equal for the moment 2119 DO jl=1,jpl 2120 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1) 2121 ENDDO 2122 ENDIF 2123 CASE( 'none' ) 2124 zdqns_ice(:,:,:) = 0._wp 2125 END SELECT 2126 2127 IF( ln_mixcpl ) THEN 2128 DO jl=1,jpl 2129 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:) 2130 ENDDO 2131 ELSE 2132 dqns_ice(:,:,:) = zdqns_ice(:,:,:) 2133 ENDIF 2134 ! ! ========================= ! 2059 2135 SELECT CASE( TRIM( sn_rcv_qsr%cldes ) ) ! solar heat fluxes ! (qsr) 2060 2136 ! ! ========================= ! 2061 2137 CASE( 'oce only' ) 2062 2138 zqsr_tot(:,: ) = MAX( 0._wp , frcv(jpr_qsroce)%z3(:,:,1) ) 2063 ! For Met Office sea ice solar fluxes are already delt with by JULES so setting to zero2064 ! here so the only flux is the ocean only one.2139 ! For the Met Office the only sea ice solar flux is the transmitted qsr which is added onto zqsr_ice 2140 ! further down. Therefore start zqsr_ice off at zero. 2065 2141 zqsr_ice(:,:,:) = 0._wp 2066 2142 CASE( 'conservative' ) … … 2115 2191 END DO 2116 2192 ENDIF 2117 2118 #if defined key_si32119 ! --- solar flux over ocean --- !2120 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax2121 zqsr_oce = 0._wp2122 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:)2123 2124 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:)2125 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF2126 #endif2127 2128 IF( ln_mixcpl ) THEN2129 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk2130 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:)* zmsk(:,:)2131 DO jl = 1, jpl2132 qsr_ice(:,:,jl) = qsr_ice(:,:,jl) * xcplmask(:,:,0) + zqsr_ice(:,:,jl)* zmsk(:,:)2133 END DO2134 ELSE2135 qsr_tot(:,: ) = zqsr_tot(:,: )2136 qsr_ice(:,:,:) = zqsr_ice(:,:,:)2137 ENDIF2138 2139 ! ! ========================= !2140 SELECT CASE( TRIM( sn_rcv_dqnsdt%cldes ) ) ! d(qns)/dt !2141 ! ! ========================= !2142 CASE ('coupled')2143 IF( TRIM(sn_rcv_dqnsdt%clcat) == 'yes' ) THEN2144 zdqns_ice(:,:,1:jpl) = frcv(jpr_dqnsdt)%z3(:,:,1:jpl)2145 ELSE2146 ! Set all category values equal for the moment2147 DO jl=1,jpl2148 zdqns_ice(:,:,jl) = frcv(jpr_dqnsdt)%z3(:,:,1)2149 ENDDO2150 ENDIF2151 CASE( 'none' )2152 zdqns_ice(:,:,:) = 0._wp2153 END SELECT2154 2155 IF( ln_mixcpl ) THEN2156 DO jl=1,jpl2157 dqns_ice(:,:,jl) = dqns_ice(:,:,jl) * xcplmask(:,:,0) + zdqns_ice(:,:,jl) * zmsk(:,:)2158 ENDDO2159 ELSE2160 dqns_ice(:,:,:) = zdqns_ice(:,:,:)2161 ENDIF2162 2163 #if defined key_si32164 ! ! ========================= !2165 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt !2166 ! ! ========================= !2167 CASE ('coupled')2168 IF (ln_scale_ice_flux) THEN2169 WHERE( a_i(:,:,:) > 1.e-10_wp )2170 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2171 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:)2172 ELSEWHERE2173 qml_ice(:,:,:) = 0.0_wp2174 qcn_ice(:,:,:) = 0.0_wp2175 END WHERE2176 ELSE2177 qml_ice(:,:,:) = frcv(jpr_topm)%z3(:,:,:)2178 qcn_ice(:,:,:) = frcv(jpr_botm)%z3(:,:,:)2179 ENDIF2180 END SELECT2181 2193 ! ! ========================= ! 2182 2194 ! ! Transmitted Qsr ! [W/m2] … … 2210 2222 ELSEIF( ln_cndflx .AND. .NOT.ln_cndemulate ) THEN !== conduction flux as surface forcing ==! 2211 2223 ! 2212 ! ! ===> here we must receive the qtr_ice_top array from the coupler 2213 ! for now just assume zero (fully opaque ice) 2224 !! SELECT CASE( TRIM( sn_rcv_qtrice%cldes ) ) 2225 !! ! 2226 !! ! ! ===> here we receive the qtr_ice_top array from the coupler 2227 !! CASE ('coupled') 2228 !! IF (ln_scale_ice_flux) THEN 2229 !! WHERE( a_i(:,:,:) > 1.e-10_wp ) 2230 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) * a_i_last_couple(:,:,:) / a_i(:,:,:) 2231 !! ELSEWHERE 2232 !! zqtr_ice_top(:,:,:) = 0.0_wp 2233 !! ENDWHERE 2234 !! ELSE 2235 !! zqtr_ice_top(:,:,:) = frcv(jpr_qtrice)%z3(:,:,:) 2236 !! ENDIF 2237 !! 2238 !! ! Add retrieved transmitted solar radiation onto the ice and total solar radiation 2239 !! zqsr_ice(:,:,:) = zqsr_ice(:,:,:) + zqtr_ice_top(:,:,:) 2240 !! zqsr_tot(:,:) = zqsr_tot(:,:) + SUM( zqtr_ice_top(:,:,:) * a_i(:,:,:), dim=3 ) 2241 !! 2242 !! ! if we are not getting this data from the coupler then assume zero (fully opaque ice) 2243 !! CASE ('none') 2214 2244 zqtr_ice_top(:,:,:) = 0._wp 2215 ! 2216 ENDIF 2217 ! 2245 !! END SELECT 2246 ! 2247 ENDIF 2248 2218 2249 IF( ln_mixcpl ) THEN 2219 DO jl=1,jpl 2250 qsr_tot(:,:) = qsr(:,:) * ziceld(:,:) + SUM( qsr_ice(:,:,:) * a_i(:,:,:), dim=3 ) ! total flux from blk 2251 qsr_tot(:,:) = qsr_tot(:,:) * xcplmask(:,:,0) + zqsr_tot(:,:) * zmsk(:,:) 2252 DO jl = 1, jpl 2253 qsr_ice (:,:,jl) = qsr_ice (:,:,jl) * xcplmask(:,:,0) + zqsr_ice (:,:,jl) * zmsk(:,:) 2220 2254 qtr_ice_top(:,:,jl) = qtr_ice_top(:,:,jl) * xcplmask(:,:,0) + zqtr_ice_top(:,:,jl) * zmsk(:,:) 2221 END DO2255 END DO 2222 2256 ELSE 2257 qsr_tot (:,: ) = zqsr_tot (:,: ) 2258 qsr_ice (:,:,:) = zqsr_ice (:,:,:) 2223 2259 qtr_ice_top(:,:,:) = zqtr_ice_top(:,:,:) 2224 2260 ENDIF 2261 2262 ! --- solar flux over ocean --- ! 2263 ! note: ziceld cannot be = 0 since we limit the ice concentration to amax 2264 zqsr_oce = 0._wp 2265 WHERE( ziceld /= 0._wp ) zqsr_oce(:,:) = ( zqsr_tot(:,:) - SUM( a_i * zqsr_ice, dim=3 ) ) / ziceld(:,:) 2266 2267 IF( ln_mixcpl ) THEN ; qsr_oce(:,:) = qsr_oce(:,:) * xcplmask(:,:,0) + zqsr_oce(:,:)* zmsk(:,:) 2268 ELSE ; qsr_oce(:,:) = zqsr_oce(:,:) ; ENDIF 2269 2225 2270 ! ! ================== ! 2226 2271 ! ! ice skin temp. ! … … 2276 2321 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 2277 2322 2278 IF( nn_components == jp_iam_o pa) THEN2323 IF( nn_components == jp_iam_oce ) THEN 2279 2324 ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) ! send temperature as it is (potential or conservative) -> use of l_useCT on the received part 2280 2325 ELSE 2281 ! we must send the surface potential temperature 2326 ! we must send the surface potential temperature 2282 2327 IF( l_useCT ) THEN ; ztmp1(:,:) = eos_pt_from_ct( CASTWP(ts(:,:,1,jp_tem,Kmm)),CASTWP(ts(:,:,1,jp_sal,Kmm)) ) 2283 2328 ELSE ; ztmp1(:,:) = ts(:,:,1,jp_tem,Kmm) … … 2428 2473 ENDIF 2429 2474 2430 ! Send ice fraction field to O PA (sent by SAS in SAS-OPAcoupling)2475 ! Send ice fraction field to OCE (sent by SAS in SAS-OCE coupling) 2431 2476 IF( ssnd(jps_fice2)%laction ) THEN 2432 2477 ztmp3(:,:,1) = fr_i(:,:) … … 2544 2589 ! i-1 i i 2545 2590 ! i i+1 (for I) 2546 IF( nn_components == jp_iam_o pa) THEN2591 IF( nn_components == jp_iam_oce ) THEN 2547 2592 zotx1(:,:) = uu(:,:,1,Kmm) 2548 2593 zoty1(:,:) = vv(:,:,1,Kmm) … … 2561 2606 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2562 2607 END_2D 2563 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2608 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2564 2609 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2565 2610 DO_2D( 0, 0, 0, 0 ) … … 2570 2615 END_2D 2571 2616 END SELECT 2572 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )2617 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp ) 2573 2618 ! 2574 2619 ENDIF … … 2638 2683 zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj) 2639 2684 END_2D 2640 CALL lbc_lnk _multi( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )2685 CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp ) 2641 2686 CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T 2642 2687 DO_2D( 0, 0, 0, 0 ) … … 2647 2692 END_2D 2648 2693 END SELECT 2649 CALL lbc_lnk _multi( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )2694 CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp ) 2650 2695 ! 2651 2696 ! … … 2701 2746 ENDIF 2702 2747 ! 2703 ! Fields sent by O PA to SAS when doing OPA<->SAS coupling2748 ! Fields sent by OCE to SAS when doing OCE<->SAS coupling 2704 2749 ! ! SSH 2705 2750 IF( ssnd(jps_ssh )%laction ) THEN … … 2725 2770 ENDIF 2726 2771 ! 2727 ! Fields sent by SAS to O PAwhen OASIS coupling2772 ! Fields sent by SAS to OCE when OASIS coupling 2728 2773 ! ! Solar heat flux 2729 2774 IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info ) -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcflx.F90
r14221 r14644 119 119 ! ! fill sf with slf_i and control print 120 120 CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 121 sf(jp_utau)%cltype = 'U' ; sf(jp_utau)%zsgn = -1._wp ! vector field at U point: overwrite default definition of cltype and zsgn 122 sf(jp_vtau)%cltype = 'V' ; sf(jp_vtau)%zsgn = -1._wp ! vector field at V point: overwrite default definition of cltype and zsgn 121 123 ! 122 124 ENDIF … … 129 131 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 130 132 ELSE 131 DO_2D( 0, 0, 0, 0)132 qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1)* tmask(ji,jj,1)133 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 134 qsr(ji,jj) = sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 133 135 END_2D 134 136 ENDIF 135 DO_2D( 0, 0, 0, 0 )! set the ocean fluxes from read fields137 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! set the ocean fluxes from read fields 136 138 utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) * umask(ji,jj,1) 137 139 vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) * vmask(ji,jj,1) … … 143 145 !!clem: I do not think it is needed 144 146 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 145 !146 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x)147 CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, &148 & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp )149 147 ! 150 148 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) … … 172 170 END_2D 173 171 ! 174 CALL lbc_lnk _multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp )172 CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 175 173 ! 176 174 END SUBROUTINE sbc_flx -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcice_cice.F90
r14053 r14644 139 139 CALL cice_sbc_force(kt) 140 140 ELSE IF( ksbc == jp_purecpl ) THEN 141 CALL sbc_cpl_ice_flx( fr_i )141 CALL sbc_cpl_ice_flx( kt, fr_i ) 142 142 ENDIF 143 143 … … 222 222 END_2D 223 223 224 CALL lbc_lnk _multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp )224 CALL lbc_lnk( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 225 225 226 226 ! set the snow+ice mass … … 312 312 ! x comp of wind stress (CI_1) 313 313 ! U point to F point 314 DO_2D( 1, 0, 1, 1)314 DO_2D( 1, 1, 1, 0 ) 315 315 ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) & 316 316 + fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1) … … 320 320 ! y comp of wind stress (CI_2) 321 321 ! V point to F point 322 DO_2D( 1, 1, 1, 0)322 DO_2D( 1, 0, 1, 1 ) 323 323 ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) & 324 324 + fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1) … … 437 437 ! x comp and y comp of surface ocean current 438 438 ! U point to F point 439 DO_2D( 1, 0, 1, 1)439 DO_2D( 1, 1, 1, 0 ) 440 440 ztmp(ji,jj)=0.5*(ssu_m(ji,jj)+ssu_m(ji,jj+1))*fmask(ji,jj,1) 441 441 END_2D … … 443 443 444 444 ! V point to F point 445 DO_2D( 1, 1, 1, 0)445 DO_2D( 1, 0, 1, 1 ) 446 446 ztmp(ji,jj)=0.5*(ssv_m(ji,jj)+ssv_m(ji+1,jj))*fmask(ji,jj,1) 447 447 END_2D … … 513 513 ! F point to V point 514 514 515 DO_2D( 1, 0, 0, 0 )515 DO_2D( 0, 0, 1, 0 ) 516 516 ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1) 517 517 END_2D … … 569 569 fmmflx(:,:) = ztmp1(:,:) !!Joakim edit 570 570 571 CALL lbc_lnk _multi( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp )571 CALL lbc_lnk( 'sbcice_cice', emp , 'T', 1.0_wp, sfx , 'T', 1.0_wp ) 572 572 573 573 ! Solar penetrative radiation and non solar surface heat flux … … 626 626 END_2D 627 627 628 CALL lbc_lnk _multi( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp )628 CALL lbc_lnk( 'sbcice_cice', fr_iu , 'U', 1.0_wp, fr_iv , 'V', 1.0_wp ) 629 629 630 630 ! set the snow+ice mass … … 877 877 ! (may be OK but not 100% sure) 878 878 879 IF(n proc==0) THEN879 IF(narea==1) THEN 880 880 ! pcg(:,:)=0.0 881 881 DO jn=1,jpnij … … 998 998 ! the lbclnk call on pn will replace these with sensible values 999 999 1000 IF(n proc==0) THEN1000 IF(narea==1) THEN 1001 1001 png(:,:,:)=0.0 1002 1002 DO jn=1,jpnij -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcmod.F90
r14219 r14644 121 121 IF(lwm) WRITE( numond, namsbc ) 122 122 ! 123 #if defined key_mpp_mpi123 #if ! defined key_mpi_off 124 124 ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp 125 125 #endif … … 164 164 ! !** check option consistency 165 165 ! 166 IF(lwp) WRITE(numout,*) !* Single / Multi - executable (NEMO / O PA+SAS)166 IF(lwp) WRITE(numout,*) !* Single / Multi - executable (NEMO / OCE+SAS) 167 167 SELECT CASE( nn_components ) 168 168 CASE( jp_iam_nemo ) 169 IF(lwp) WRITE(numout,*) ' ==>>> NEMO configured as a single executable (i.e. including both O PAand Surface module)'170 CASE( jp_iam_o pa)171 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, O PAcomponent'172 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but key_oasis3 disabled' )173 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_cpl = T in OPA' )174 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )169 IF(lwp) WRITE(numout,*) ' ==>>> NEMO configured as a single executable (i.e. including both OCE and Surface module)' 170 CASE( jp_iam_oce ) 171 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, OCE component' 172 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 173 IF( ln_cpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_cpl = T in OCE' ) 174 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 175 175 CASE( jp_iam_sas ) 176 176 IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, SAS component' 177 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but key_oasis3 disabled' )178 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : O PA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )177 IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but key_oasis3 disabled' ) 178 IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OCE-SAS coupled via OASIS, but ln_mixcpl = T in OCE' ) 179 179 CASE DEFAULT 180 180 CALL ctl_stop( 'sbc_init : unsupported value for nn_components' ) … … 225 225 ! 226 226 IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero 227 IF( nn_components /= jp_iam_o pa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPAcoupled case227 IF( nn_components /= jp_iam_oce ) fr_i(:,:) = 0._wp ! except for OCE in SAS-OCE coupled case 228 228 ENDIF 229 229 ! … … 238 238 IF( ln_dm2dc ) THEN !* daily mean to diurnal cycle 239 239 !LB:nday_qsr = -1 ! allow initialization at the 1st call 240 IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_o pa) &240 IF( .NOT.( ln_flx .OR. ln_blk .OR. ln_abl ) .AND. nn_components /= jp_iam_oce ) & 241 241 & CALL ctl_stop( 'qsr diurnal cycle from daily values requires flux, bulk or abl formulation' ) 242 242 ENDIF … … 245 245 ! 246 246 ll_purecpl = ln_cpl .AND. .NOT.ln_mixcpl 247 ll_opa = nn_components == jp_iam_o pa247 ll_opa = nn_components == jp_iam_oce 248 248 ll_not_nemo = nn_components /= jp_iam_nemo 249 249 icpt = 0 … … 267 267 CASE( jp_purecpl ) ; WRITE(numout,*) ' ==>>> pure coupled formulation' 268 268 !!gm abusive use of jp_none ?? ===>>> need to be check and changed by adding a jp_sas parameter 269 CASE( jp_none ) ; WRITE(numout,*) ' ==>>> O PAcoupled to SAS via oasis'269 CASE( jp_none ) ; WRITE(numout,*) ' ==>>> OCE coupled to SAS via oasis' 270 270 IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation' 271 271 END SELECT … … 277 277 IF( lk_oasis ) CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 278 278 ! ! (2) the use of nn_fsbc 279 ! nn_fsbc initialization if O PA-SAS coupling via OASIS279 ! nn_fsbc initialization if OCE-SAS coupling via OASIS 280 280 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly 281 281 IF( nn_components /= jp_iam_nemo ) THEN 282 IF( nn_components == jp_iam_o pa) nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt)282 IF( nn_components == jp_iam_oce ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rn_Dt) 283 283 IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rn_Dt) 284 284 ! 285 285 IF(lwp)THEN 286 286 WRITE(numout,*) 287 WRITE(numout,*)" O PA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc287 WRITE(numout,*)" OCE-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc 288 288 WRITE(numout,*) 289 289 ENDIF … … 405 405 ! 406 406 ll_sas = nn_components == jp_iam_sas ! component flags 407 ll_opa = nn_components == jp_iam_o pa407 ll_opa = nn_components == jp_iam_oce 408 408 ! 409 409 IF( .NOT.ll_sas ) CALL sbc_ssm ( kt, Kbb, Kmm ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) … … 417 417 CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation 418 418 CASE( jp_blk ) 419 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-SAS coupling: SAS receiving fields from OPA419 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE 420 420 !!!!!!!!!!! ATTENTION:ln_wave is not only used for oasis coupling !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 421 421 IF( ln_wave ) THEN 422 IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-wave coupling422 IF ( lk_oasis ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-wave coupling 423 423 CALL sbc_wave ( kt, Kmm ) 424 424 ENDIF … … 426 426 ! 427 427 CASE( jp_abl ) 428 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-SAS coupling: SAS receiving fields from OPA428 IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: SAS receiving fields from OCE 429 429 CALL sbc_abl ( kt ) ! ABL formulation for the ocean 430 430 ! 431 431 CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! pure coupled formulation 432 432 CASE( jp_none ) 433 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! O PA-SAS coupling: OPAreceiving fields from SAS433 IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice, Kbb, Kmm ) ! OCE-SAS coupling: OCE receiving fields from SAS 434 434 END SELECT 435 435 ! -
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcwave.F90
r14219 r14644 211 211 ENDIF 212 212 213 CALL lbc_lnk _multi( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp )213 CALL lbc_lnk( 'sbcwave', usd, 'U', -1.0_wp, vsd, 'V', -1.0_wp ) 214 214 215 215 ! … … 503 503 ! 504 504 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 505 sf_sd(jp_usd)%zsgn = -1._wp ; sf_sd(jp_vsd)%zsgn = -1._wp ! vector field at T point: overwrite default definition of zsgn 505 506 ENDIF 506 507 !
Note: See TracChangeset
for help on using the changeset viewer.