MODULE trcrst_medusa !!====================================================================== !! *** MODULE trcrst_medusa *** !! TOP : create, write, read the restart files of MEDUSA tracer !!====================================================================== !! History : 1.0 ! 2010-01 (C. Ethe) Original !! 1.1 ! 2014-07 (A. Yool; J. Palmieri) converted for MEDUSA !! 1.2 ! 2015-07 (A. Yool) add averaged fields for DMS !!---------------------------------------------------------------------- #if defined key_medusa !!---------------------------------------------------------------------- !! 'key_medusa' medusa tracers !!---------------------------------------------------------------------- !! trc_rst_read_medusa : read restart file !! trc_rst_wri_medusa : write restart file !!---------------------------------------------------------------------- USE oce_trc ! Ocean variables USE par_trc ! TOP parameters USE trc ! TOP variables USE trcsms_medusa ! MEDUSA sms trends USE sms_medusa ! MEDUSA sms trends USE iom IMPLICIT NONE PRIVATE PUBLIC trc_rst_read_medusa ! called by trcini.F90 module (actually trcrst.F90) PUBLIC trc_rst_wri_medusa ! called by trcini.F90 module (actually trcrst.F90) CONTAINS SUBROUTINE trc_rst_read_medusa( knum ) !!---------------------------------------------------------------------- !! *** trc_rst_read_medusa *** !! !! ** Purpose : Read in restart file specific variables from medusa model !! !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: knum ! unit of the restart file !! AXY (07/07/14): temporary variables REAL(wp) :: fq0,fq1,fq2 !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' trc_rst_read_medusa : Read specific variables from medusa model ' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' !! AXY (07/07/14): remove LOBSTER calls !! CALL iom_get( knum, jpdom_autoglo, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) !! CALL iom_get( knum, jpdom_autoglo, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) !! AXY (07/07/14): as well as passive tracers, the restart files !! contain 2D fields of sediments; these need to !! be read in specially; hence this routine !! !! AXY (13/01/12): check if the restart contains sediment fields; !! this is only relevant for simulations that include !! biogeochemistry and are restarted from earlier runs !! in which there was no sediment component !! IF( iom_varid( knum, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN !! YES; in which case read them !! IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' CALL iom_get( knum, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) ELSE !! NO; in which case set them to zero !! IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' zb_sed_n(:,:) = 0.0 !! organic N zn_sed_n(:,:) = 0.0 zb_sed_fe(:,:) = 0.0 !! organic Fe zn_sed_fe(:,:) = 0.0 zb_sed_si(:,:) = 0.0 !! inorganic Si zn_sed_si(:,:) = 0.0 zb_sed_c(:,:) = 0.0 !! organic C zn_sed_c(:,:) = 0.0 zb_sed_ca(:,:) = 0.0 !! inorganic C zn_sed_ca(:,:) = 0.0 ENDIF !! !! calculate stats on these fields IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' fq0 = MINVAL(zn_sed_n(:,:)) fq1 = MAXVAL(zn_sed_n(:,:)) fq2 = SUM(zn_sed_n(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_fe(:,:)) fq1 = MAXVAL(zn_sed_fe(:,:)) fq2 = SUM(zn_sed_fe(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_si(:,:)) fq1 = MAXVAL(zn_sed_si(:,:)) fq2 = SUM(zn_sed_si(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_c(:,:)) fq1 = MAXVAL(zn_sed_c(:,:)) fq2 = SUM(zn_sed_c(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_ca(:,:)) fq1 = MAXVAL(zn_sed_ca(:,:)) fq2 = SUM(zn_sed_ca(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & & fq0, fq1, fq2 !! AXY (07/07/15): read in temporally averaged fields for DMS !! calculations !! IF( iom_varid( knum, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN !! YES; in which case read them !! IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) ) CALL iom_get( knum, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) ) ELSE !! NO; in which case set them to zero !! IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' zb_dms_chn(:,:) = 0.0 !! CHN zn_dms_chn(:,:) = 0.0 zb_dms_chd(:,:) = 0.0 !! CHD zn_dms_chd(:,:) = 0.0 zb_dms_mld(:,:) = 0.0 !! MLD zn_dms_mld(:,:) = 0.0 zb_dms_qsr(:,:) = 0.0 !! QSR zn_dms_qsr(:,:) = 0.0 zb_dms_din(:,:) = 0.0 !! DIN zn_dms_din(:,:) = 0.0 ENDIF !! !! calculate stats on these fields IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' fq0 = MINVAL(zn_dms_chn(:,:)) fq1 = MAXVAL(zn_dms_chn(:,:)) fq2 = SUM(zn_dms_chn(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_chd(:,:)) fq1 = MAXVAL(zn_dms_chd(:,:)) fq2 = SUM(zn_dms_chd(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_mld(:,:)) fq1 = MAXVAL(zn_dms_mld(:,:)) fq2 = SUM(zn_dms_mld(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_qsr(:,:)) fq1 = MAXVAL(zn_dms_qsr(:,:)) fq2 = SUM(zn_dms_qsr(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_din(:,:)) fq1 = MAXVAL(zn_dms_din(:,:)) fq2 = SUM(zn_dms_din(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2 END SUBROUTINE trc_rst_read_medusa SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum ) !!---------------------------------------------------------------------- !! *** trc_rst_read_medusa *** !! !! ** Purpose : Read in restart file specific variables from medusa model !! !!---------------------------------------------------------------------- INTEGER, INTENT(in) :: kt ! time step INTEGER, INTENT(in) :: kitrst ! time step of restart write INTEGER, INTENT(in) :: knum ! unit of the restart file !! AXY (07/07/14): temporary variables REAL(wp) :: fq0,fq1,fq2 !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' trc_rst_wri_medusa : Write specific variables from medusa model ' IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' !! AXY (07/07/14): remove LOBSTER calls !! CALL iom_rstput( kt, kitrst, knum, 'SEDB'//ctrcnm(jp_lob_det), sedpocb(:,:) ) !! CALL iom_rstput( kt, kitrst, knum, 'SEDN'//ctrcnm(jp_lob_det), sedpocn(:,:) ) !! AXY (07/07/14): as well as passive tracers, the restart files !! contain 2D fields of sediments; these need to !! be written out specially; hence this routine !! !! AXY (13/01/12): write out "before" and "now" state of seafloor !! sediment pools into restart; this happens !! whether or not the pools are to be used by !! MEDUSA (which is controlled by a switch in the !! namelist_top file) !! IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' CALL iom_rstput( kt, kitrst, knum, 'B_SED_N', zb_sed_n(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_SED_N', zn_sed_n(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_SED_FE', zb_sed_fe(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_SED_FE', zn_sed_fe(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_SED_SI', zb_sed_si(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_SED_SI', zn_sed_si(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_SED_C', zb_sed_c(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_SED_C', zn_sed_c(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_SED_CA', zb_sed_ca(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_SED_CA', zn_sed_ca(:,:) ) !! !! calculate stats on these fields IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' fq0 = MINVAL(zn_sed_n(:,:)) fq1 = MAXVAL(zn_sed_n(:,:)) fq2 = SUM(zn_sed_n(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment N ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_fe(:,:)) fq1 = MAXVAL(zn_sed_fe(:,:)) fq2 = SUM(zn_sed_fe(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Fe ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_si(:,:)) fq1 = MAXVAL(zn_sed_si(:,:)) fq2 = SUM(zn_sed_si(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Si ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_c(:,:)) fq1 = MAXVAL(zn_sed_c(:,:)) fq2 = SUM(zn_sed_c(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment C ', & & fq0, fq1, fq2 fq0 = MINVAL(zn_sed_ca(:,:)) fq1 = MAXVAL(zn_sed_ca(:,:)) fq2 = SUM(zn_sed_ca(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'Sediment Ca ', & & fq0, fq1, fq2 !! AXY (07/07/15): write out temporally averaged fields for DMS !! calculations !! IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHN', zb_dms_chn(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHN', zn_dms_chn(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_DMS_CHD', zb_dms_chd(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_DMS_CHD', zn_dms_chd(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_DMS_MLD', zb_dms_mld(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_DMS_MLD', zn_dms_mld(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_DMS_QSR', zb_dms_qsr(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_DMS_QSR', zn_dms_qsr(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'B_DMS_DIN', zb_dms_din(:,:) ) CALL iom_rstput( kt, kitrst, knum, 'N_DMS_DIN', zn_dms_din(:,:) ) !! !! calculate stats on these fields IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' fq0 = MINVAL(zn_dms_chn(:,:)) fq1 = MAXVAL(zn_dms_chn(:,:)) fq2 = SUM(zn_dms_chn(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHN ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_chd(:,:)) fq1 = MAXVAL(zn_dms_chd(:,:)) fq2 = SUM(zn_dms_chd(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, CHD ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_mld(:,:)) fq1 = MAXVAL(zn_dms_mld(:,:)) fq2 = SUM(zn_dms_mld(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, MLD ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_qsr(:,:)) fq1 = MAXVAL(zn_dms_qsr(:,:)) fq2 = SUM(zn_dms_qsr(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, QSR ', fq0, fq1, fq2 fq0 = MINVAL(zn_dms_din(:,:)) fq1 = MAXVAL(zn_dms_din(:,:)) fq2 = SUM(zn_dms_din(:,:)) if (lwp) write (numout,'(a,3f15.5)') 'DMS, DIN ', fq0, fq1, fq2 END SUBROUTINE trc_rst_wri_medusa #else !!---------------------------------------------------------------------- !! Dummy module : No passive tracer !!---------------------------------------------------------------------- CONTAINS SUBROUTINE trc_rst_read_medusa( knum ) INTEGER, INTENT(in) :: knum WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?',knum END SUBROUTINE trc_rst_read_medusa SUBROUTINE trc_rst_wri_medusa( kt, kitrst, knum ) INTEGER, INTENT(in) :: kt, kitrst, knum WRITE(*,*) 'trc_rst_wri_medusa: You should not have seen this print! error?', kt, kitrst, knum END SUBROUTINE trc_rst_wri_medusa #endif !!====================================================================== END MODULE trcrst_medusa