- Timestamp:
- 2017-12-19T09:26:25+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
r5215 r9124 1 1 MODULE icbstp 2 3 2 !!====================================================================== 4 3 !! *** MODULE icbstp *** … … 13 12 !! - ! into icb copies with haloes 14 13 !!---------------------------------------------------------------------- 14 15 15 !!---------------------------------------------------------------------- 16 16 !! icb_stp : start iceberg tracking … … 20 20 USE dom_oce ! ocean domain 21 21 USE sbc_oce ! ocean surface forcing 22 USE phycst 22 USE phycst ! physical constants 23 ! 24 USE icb_oce ! iceberg: define arrays 25 USE icbini ! iceberg: initialisation routines 26 USE icbutl ! iceberg: utility routines 27 USE icbrst ! iceberg: restart routines 28 USE icbdyn ! iceberg: dynamics (ie advection) routines 29 USE icbclv ! iceberg: calving routines 30 USE icbthm ! iceberg: thermodynamics routines 31 USE icblbc ! iceberg: lateral boundary routines (including mpp) 32 USE icbtrj ! iceberg: trajectory I/O routines 33 USE icbdia ! iceberg: budget 34 ! 23 35 USE in_out_manager ! nemo IO 24 USE lib_mpp 25 USE iom 26 USE fldread 36 USE lib_mpp ! massively parallel library 37 USE iom ! I/O manager 38 USE fldread ! field read 27 39 USE timing ! timing 28 29 USE icb_oce ! define iceberg arrays30 USE icbini ! iceberg initialisation routines31 USE icbutl ! iceberg utility routines32 USE icbrst ! iceberg restart routines33 USE icbdyn ! iceberg dynamics (ie advection) routines34 USE icbclv ! iceberg calving routines35 USE icbthm ! iceberg thermodynamics routines36 USE icblbc ! iceberg lateral boundary routines (including mpp)37 USE icbtrj ! iceberg trajectory I/O routines38 USE icbdia ! iceberg budget39 40 40 41 IMPLICIT NONE … … 64 65 !!---------------------------------------------------------------------- 65 66 ! 66 IF( nn_timing == 1 )CALL timing_start('icb_stp')67 IF( ln_timing ) CALL timing_start('icb_stp') 67 68 68 ! ! start of timestep housekeeping69 69 ! !== start of timestep housekeeping ==! 70 ! 70 71 nktberg = kt 71 72 IF( nn_test_icebergs < 0 ) THEN !read calving data72 ! 73 IF( nn_test_icebergs < 0 ) THEN !* read calving data 73 74 ! 74 75 CALL fld_read ( kt, 1, sf_icb ) 75 src_calving (:,:)= sf_icb(1)%fnow(:,:,1) ! calving in km^3/year (water equivalent)76 src_calving (:,:) = sf_icb(1)%fnow(:,:,1) ! calving in km^3/year (water equivalent) 76 77 src_calving_hflx(:,:) = 0._wp ! NO heat flux for now 77 78 ! 78 79 ENDIF 79 80 ! 80 81 berg_grid%floating_melt(:,:) = 0._wp 81 82 ! anything that needs to be reset to zero each timestep for budgets is dealt with here 83 CALL icb_dia_step() 84 82 ! 83 ! !* anything that needs to be reset to zero each timestep 84 CALL icb_dia_step() ! for budgets is dealt with here 85 ! 86 ! !* write out time 85 87 ll_verbose = .FALSE. 86 IF( nn_verbose_write > 0 .AND. & 87 MOD(kt-1,nn_verbose_write ) == 0 ) ll_verbose = nn_verbose_level >= 0 88 89 ! write out time 90 IF( ll_verbose ) WRITE(numicb,9100) nktberg, ndastp, nsec_day 88 IF( nn_verbose_write > 0 .AND. MOD( kt-1 , nn_verbose_write ) == 0 ) ll_verbose = ( nn_verbose_level >= 0 ) 89 ! 90 IF( ll_verbose ) WRITE(numicb,9100) nktberg, ndastp, nsec_day 91 91 9100 FORMAT('kt= ',i8, ' day= ',i8,' secs=',i8) 92 93 ! copy nemo forcing arrays into iceberg versions with extra halo 94 ! only necessary for variables not on T points 95 CALL icb_utl_copy() 96 97 !!---------------------------------------------------------------------- 98 !! process icebergs 99 92 ! 93 ! !* copy nemo forcing arrays into iceberg versions with extra halo 94 CALL icb_utl_copy() ! only necessary for variables not on T points 95 ! 96 ! 97 ! !== process icebergs ==! 98 ! ! 100 99 CALL icb_clv_flx( kt ) ! Accumulate ice from calving 101 100 ! ! 102 101 CALL icb_clv() ! Calve excess stored ice into icebergs 103 104 105 !!== For each berg, evolve ==!102 ! ! 103 ! 104 ! !== For each berg, evolve ==! 106 105 ! 107 106 IF( ASSOCIATED(first_berg) ) CALL icb_dyn( kt ) ! ice berg dynamics 108 107 109 IF( lk_mpp ) THEN ;CALL icb_lbc_mpp() ! Send bergs to other PEs110 ELSE ;CALL icb_lbc() ! Deal with any cyclic boundaries in non-mpp case108 IF( lk_mpp ) THEN ; CALL icb_lbc_mpp() ! Send bergs to other PEs 109 ELSE ; CALL icb_lbc() ! Deal with any cyclic boundaries in non-mpp case 111 110 ENDIF 112 111 113 112 IF( ASSOCIATED(first_berg) ) CALL icb_thm( kt ) ! Ice berg thermodynamics (melting) + rolling 114 115 !!---------------------------------------------------------------------- 116 !! end of timestep housekeeping 117 113 ! 114 ! 115 ! !== diagnostics and output ==! 116 ! 117 ! !* For each berg, record trajectory (when needed) 118 118 ll_sample_traj = .FALSE. 119 119 IF( nn_sample_rate > 0 .AND. MOD(kt-1,nn_sample_rate) == 0 ) ll_sample_traj = .TRUE. 120 IF( ll_sample_traj .AND. & 121 ASSOCIATED(first_berg) ) CALL icb_trj_write( kt ) ! For each berg, record trajectory 120 IF( ll_sample_traj .AND. ASSOCIATED(first_berg) ) CALL icb_trj_write( kt ) 122 121 123 ! Gridded diagnostics124 ! To get these iom_put's and those preceding to actually do something125 ! use key_iomput in cpp file and create content for XML file126 122 ! !* Gridded diagnostics 123 ! ! To get these iom_put's and those preceding to actually do something 124 ! ! use key_iomput in cpp file and create content for XML file 125 ! 127 126 CALL iom_put( "calving" , berg_grid%calving (:,:) ) ! 'calving mass input' 128 127 CALL iom_put( "berg_floating_melt", berg_grid%floating_melt(:,:) ) ! 'Melt rate of icebergs + bits' , 'kg/m2/s' 129 128 CALL iom_put( "berg_stored_ice" , berg_grid%stored_ice (:,:,:) ) ! 'Accumulated ice mass by class', 'kg' 130 131 ! store mean budgets 132 CALL icb_dia_put() 133 134 ! Dump icebergs to screen 135 if ( nn_verbose_level >= 2 ) CALL icb_utl_print( 'icb_stp, status', kt ) 136 137 ! Diagnose budgets 129 ! 130 CALL icb_dia_put() !* store mean budgets 131 ! 132 ! !* Dump icebergs to screen 133 IF( nn_verbose_level >= 2 ) CALL icb_utl_print( 'icb_stp, status', kt ) 134 ! 135 ! !* Diagnose budgets 138 136 ll_budget = .FALSE. 139 137 IF( nn_verbose_write > 0 .AND. MOD(kt-1,nn_verbose_write) == 0 ) ll_budget = ln_bergdia 140 138 CALL icb_dia( ll_budget ) 141 142 IF( MOD(kt,nn_stock) == 0 ) THEN 139 ! 140 IF( MOD(kt,nn_stock) == 0 ) THEN !* restart 143 141 CALL icb_rst_write( kt ) 144 142 IF( nn_sample_rate > 0 ) CALL icb_trj_sync() 145 143 ENDIF 146 147 IF( nn_timing == 1 )CALL timing_stop('icb_stp')144 ! 145 IF( ln_timing ) CALL timing_stop('icb_stp') 148 146 ! 149 147 END SUBROUTINE icb_stp … … 157 155 !! 158 156 !!---------------------------------------------------------------------- 159 INTEGER, INTENT( in ) :: kt157 INTEGER, INTENT( in ) :: kt ! model time-step index 160 158 !!---------------------------------------------------------------------- 161 159 ! 162 160 ! only write a restart if not done in icb_stp 163 IF( MOD(kt,nn_stock) .NE. 0 )CALL icb_rst_write( kt )161 IF( MOD(kt,nn_stock) /= 0 ) CALL icb_rst_write( kt ) 164 162 165 163 ! finish with trajectories if they were written 166 IF( nn_sample_rate .GT. 0 )CALL icb_trj_end()164 IF( nn_sample_rate > 0 ) CALL icb_trj_end() 167 165 168 IF(lwp) WRITE(numout,'(a,i6)') 'icebergs: icb_end complete', narea 166 IF(lwp) WRITE(numout,'(a,i6)') 'icebergs: icb_end complete', narea 167 ! 169 168 CALL flush( numicb ) 170 169 CLOSE( numicb ) … … 173 172 174 173 !!------------------------------------------------------------------------- 175 176 174 END MODULE icbstp
Note: See TracChangeset
for help on using the changeset viewer.
