Ignore:
Timestamp:
2019-02-01T17:27:20+01:00 (19 months ago)
Author:
dford
Message:

Implement biogeochemistry assimilation for FABM-ERSEM.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/AMM15_v3_6_STABLE_package_collate_BGC_DA/NEMOGCM/NEMO/TOP_SRC/FABM/trcsms_fabm.F90

    r10156 r10622  
    3333   USE inputs_fabm 
    3434   USE vertical_movement_fabm 
     35   USE zdfmxl 
     36   USE asmbgc, ONLY: mld_choice_bgc 
     37   USE lbclnk 
    3538 
    3639   !USE fldread         !  time interpolation 
     
    113116 
    114117      CALL st2d_fabm_nxt( kt ) 
     118       
     119      CALL asmdiags_fabm( kt ) 
    115120 
    116121      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrfabm ) 
     
    130135 
    131136   END SUBROUTINE trc_sms_fabm 
     137    
     138   SUBROUTINE asmdiags_fabm( kt ) 
     139      INTEGER, INTENT(IN) :: kt 
     140      INTEGER :: ji,jj,jk,jkmax 
     141      REAL(wp), DIMENSION(jpi,jpj,jpk) :: pgrow_3d, ploss_3d, zmld 
     142       
     143      IF (kt == nittrc000) THEN 
     144         MLD_MAX(:,:) = 0.0 
     145      ENDIF 
     146      PGROW_AVG(:,:) = 0.0 
     147      PLOSS_AVG(:,:) = 0.0 
     148      PHYT_AVG(:,:)  = 0.0 
     149         
     150      pgrow_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_pgrow) 
     151      ploss_3d(:,:,:) = fabm_get_bulk_diagnostic_data(model, jp_fabm_ploss) 
     152       
     153      SELECT CASE( mld_choice_bgc ) 
     154      CASE ( 1 )                   ! Turbocline/mixing depth [W points] 
     155         zmld(:,:) = hmld(:,:) 
     156      CASE ( 2 )                   ! Density criterion (0.01 kg/m^3 change from 10m) [W points] 
     157         zmld(:,:) = hmlp(:,:) 
     158      CASE ( 3 )                   ! Kara MLD [Interpolated] 
     159#if defined key_karaml 
     160         IF ( ln_kara ) THEN 
     161            zmld(:,:) = hmld_kara(:,:) 
     162         ELSE 
     163            CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 
     164               &           ' but ln_kara=.false.' ) 
     165         ENDIF 
     166#else 
     167         CALL ctl_stop( ' Kara mixed layer requested for BGC assimilation,', & 
     168            &           ' but is not defined' ) 
     169#endif 
     170      CASE ( 4 )                   ! Temperature criterion (0.2 K change from surface) [T points] 
     171         zmld(:,:) = hmld_tref(:,:) 
     172      CASE ( 5 )                   ! Density criterion (0.01 kg/m^3 change from 10m) [T points] 
     173         zmld(:,:) = hmlpt(:,:) 
     174      END SELECT 
     175    
     176      DO jj = 2, jpjm1 
     177         DO ji = 2, jpim1 
     178            ! 
     179            jkmax = jpk-1 
     180            DO jk = jpk-1, 1, -1 
     181               IF ( ( zmld(ji,jj) >  gdepw_n(ji,jj,jk)   ) .AND. & 
     182                  & ( zmld(ji,jj) <= gdepw_n(ji,jj,jk+1) ) ) THEN 
     183                  zmld(ji,jj) = gdepw_n(ji,jj,jk+1) 
     184                  jkmax = jk 
     185               ENDIF 
     186            END DO 
     187            ! 
     188            DO jk = 1, jkmax 
     189               PHYT_AVG(ji,jj) = PHYT_AVG(ji,jj) + & 
     190                  &              trn(ji,jj,jk,jp_fabm_p1n) + & 
     191                  &              trn(ji,jj,jk,jp_fabm_p2n) + & 
     192                  &              trn(ji,jj,jk,jp_fabm_p3n) + & 
     193                  &              trn(ji,jj,jk,jp_fabm_p4n) 
     194               IF ( pgrow_3d(ji,jj,jk) .GT. 0.0 ) THEN 
     195                  PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) + & 
     196                     &               pgrow_3d(ji,jj,jk) 
     197               ENDIF 
     198               IF ( ploss_3d(ji,jj,jk) .GT. 0.0 ) THEN 
     199                  PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) + & 
     200                     &               ploss_3d(ji,jj,jk) 
     201               ENDIF 
     202            END DO 
     203            
     204            PHYT_AVG(ji,jj)  = PHYT_AVG(ji,jj)  / REAL(jkmax) 
     205            PGROW_AVG(ji,jj) = PGROW_AVG(ji,jj) / REAL(jkmax) 
     206            PLOSS_AVG(ji,jj) = PLOSS_AVG(ji,jj) / REAL(jkmax) 
     207    
     208            IF ( zmld(ji,jj) .GT. MLD_MAX(ji,jj) ) THEN 
     209               MLD_MAX(ji,jj) = zmld(ji,jj) 
     210            ENDIF 
     211            ! 
     212         END DO 
     213      END DO 
     214       
     215      PHYT_AVG(:,:)  = PHYT_AVG(:,:)  * tmask(:,:,1) 
     216      PGROW_AVG(:,:) = PGROW_AVG(:,:) * tmask(:,:,1) 
     217      PLOSS_AVG(:,:) = PLOSS_AVG(:,:) * tmask(:,:,1) 
     218      MLD_MAX(:,:)   = MLD_MAX(:,:)   * tmask(:,:,1) 
     219       
     220   END SUBROUTINE asmdiags_fabm 
    132221 
    133222   SUBROUTINE compute_fabm() 
Note: See TracChangeset for help on using the changeset viewer.