Changeset 14219 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcflx.F90
- Timestamp:
- 2020-12-18T18:52:57+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcflx.F90
r14072 r14219 35 35 INTEGER , PARAMETER :: jp_emp = 5 ! index of evaporation-precipation file 36 36 !!INTEGER , PARAMETER :: jp_sfx = 6 ! index of salt flux flux 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 37 INTEGER , PARAMETER :: jpfld = 5 !! 6 ! maximum number of files to read 38 38 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read) 39 39 … … 50 50 !!--------------------------------------------------------------------- 51 51 !! *** ROUTINE sbc_flx *** 52 !! 52 !! 53 53 !! ** Purpose : provide at each time step the surface ocean fluxes 54 !! (momentum, heat, freshwater and runoff) 54 !! (momentum, heat, freshwater and runoff) 55 55 !! 56 56 !! ** Method : - READ each fluxes in NetCDF files: … … 91 91 !!--------------------------------------------------------------------- 92 92 ! 93 IF( kt == nit000 ) THEN ! First call kt=nit000 93 IF( kt == nit000 ) THEN ! First call kt=nit000 94 94 ! set file information 95 95 READ ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) … … 98 98 READ ( numnam_cfg, namsbc_flx, IOSTAT = ios, ERR = 902 ) 99 99 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_flx in configuration namelist' ) 100 IF(lwm) WRITE ( numond, namsbc_flx ) 100 IF(lwm) WRITE ( numond, namsbc_flx ) 101 101 ! 102 102 ! ! check: do we plan to use ln_dm2dc with non-daily forcing? 103 103 IF( ln_dm2dc .AND. sn_qsr%freqh /= 24. ) & 104 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 104 & CALL ctl_stop( 'sbc_blk_core: ln_dm2dc can be activated only with daily short-wave forcing' ) 105 105 ! 106 106 ! ! store namelist information in an array 107 107 slf_i(jp_utau) = sn_utau ; slf_i(jp_vtau) = sn_vtau 108 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 108 slf_i(jp_qtot) = sn_qtot ; slf_i(jp_qsr ) = sn_qsr 109 109 slf_i(jp_emp ) = sn_emp !! ; slf_i(jp_sfx ) = sn_sfx 110 110 ! 111 111 ALLOCATE( sf(jpfld), STAT=ierror ) ! set sf structure 112 IF( ierror > 0 ) THEN 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 112 IF( ierror > 0 ) THEN 113 CALL ctl_stop( 'sbc_flx: unable to allocate sf structure' ) ; RETURN 114 114 ENDIF 115 115 DO ji= 1, jpfld … … 123 123 124 124 CALL fld_read( kt, nn_fsbc, sf ) ! input fields provided at the current time-step 125 125 126 126 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! update ocean fluxes at each SBC frequency 127 127 128 128 IF( ln_dm2dc ) THEN ! modify now Qsr to include the diurnal cycle 129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask( :,:,1)129 qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(ji,jj,1) 130 130 ELSE 131 131 DO_2D( 0, 0, 0, 0 ) … … 138 138 qns (ji,jj) = ( sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) ) * tmask(ji,jj,1) 139 139 emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) * tmask(ji,jj,1) 140 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 140 !!sfx (ji,jj) = sf(jp_sfx )%fnow(ji,jj,1) * tmask(ji,jj,1) 141 141 END_2D 142 142 ! ! add to qns the heat due to e-p … … 144 144 !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp ! mass flux is at SST 145 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 ) 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( 'sbcflx', utau, 'U', -1._wp) 148 CALL lbc_lnk( 'sbcflx', vtau, 'V', -1._wp) 149 CALL lbc_lnk( 'sbcflx', qns, 'T', 1._wp) 150 CALL lbc_lnk( 'sbcflx', emp, 'T', 1._wp) 151 CALL lbc_lnk( 'sbcflx', qsr, 'T', 1._wp) 152 153 ! 154 ! 155 ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 156 !CALL lbc_lnk_multi( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 157 ! & qns, 'T', 1._wp, emp , 'T', 1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp ) 149 158 ! 150 159 IF( nitend-nit000 <= 100 .AND. lwp ) THEN ! control print (if less than 100 time-step asked) 151 WRITE(numout,*) 160 WRITE(numout,*) 152 161 WRITE(numout,*) ' read daily momentum, heat and freshwater fluxes OK' 153 162 DO jf = 1, jpfld … … 155 164 IF( jf == jp_qtot .OR. jf == jp_qsr ) zfact = 0.1 156 165 IF( jf == jp_emp ) zfact = 86400. 157 WRITE(numout,*) 166 WRITE(numout,*) 158 167 WRITE(numout,*) ' day: ', ndastp , TRIM(sf(jf)%clvar), ' * ', zfact 159 168 END DO … … 166 175 DO_2D( 0, 0, 0, 0 ) 167 176 ztx = ( utau(ji-1,jj ) + utau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( umask(ji-1,jj ,1), umask(ji,jj,1) ) ) 168 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 177 zty = ( vtau(ji ,jj-1) + vtau(ji,jj) ) * 0.5_wp * ( 2._wp - MIN( vmask(ji ,jj-1,1), vmask(ji,jj,1) ) ) 169 178 zmod = 0.5_wp * SQRT( ztx * ztx + zty * zty ) * tmask(ji,jj,1) 170 179 taum(ji,jj) = zmod … … 172 181 END_2D 173 182 ! 174 CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 183 CALL lbc_lnk( 'sbcflx', taum, 'T', 1._wp) 184 CALL lbc_lnk( 'sbcflx', wndm, 'T', 1._wp) 185 ! CALL lbc_lnk_multi( 'sbcflx', taum, 'T', 1._wp, wndm, 'T', 1._wp ) 175 186 ! 176 187 END SUBROUTINE sbc_flx … … 178 189 !!====================================================================== 179 190 END MODULE sbcflx 191
Note: See TracChangeset
for help on using the changeset viewer.
