SUBROUTINE ice_bio_interp_phy2bio(kideb,kiut,nlay_i,ln_write) ! This routine interpolates salinity, temperature, brine salinity, brine volume ! on the biological grid ! (c) Martin Vancoppenolle, May 2007 INCLUDE 'type.com' INCLUDE 'para.com' INCLUDE 'const.com' INCLUDE 'ice.com' INCLUDE 'thermo.com' INCLUDE 'bio.com' INTEGER :: & ji , ! : index for space & jk , ! : index for ice layers & jn , ! : index for tracers & layer1 , ! : relayering index & layer2 ! : relayering index REAL(8), DIMENSION( maxnlay ) :: & zqs , ! : scalar content on the physical grid (input) & zqt ! : scalar content on the physical grid (input) REAL(8), DIMENSION( nlay_bio ) :: & zq1 ! : scalar content on the biological grid (output) REAL(8), DIMENSION( nlay_bio , maxnlay ) :: & zweight ! : relayering matrix REAL(8) :: & zaaa , ! : dummyfactors for the computation of t_i_bio & zbbb , & zccc , & zdiscrim , & zsum0 ! : conservation test variable & zsum1 ! : conservation test variable LOGICAL :: & ln_write !=============================================================================! IF ( ln_write ) THEN WRITE(numout,*) ' *** ice_bio_interp_phy2bio : ' WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ENDIF DO ji = kideb, kiut ! !-----------------------------------------------------------------------------! ! 1) Scalar contents !-----------------------------------------------------------------------------! ! DO layer = 1, nlay_i zqs(layer) = s_i_b(ji,layer) * deltaz_i_phy(layer) zqt(layer) = q_i_b(ji,layer) * deltaz_i_phy(layer) END DO ! layer IF ( ln_write ) THEN ! WRITE(numout,*) ' s_i_b : ', ( s_i_b(ji,layer1) , ! & layer1 = 1, nlay_i ) ! WRITE(numout,*) ' q_i_b : ', ( q_i_b(ji,layer1) , ! & layer1 = 1, nlay_i ) ! WRITE(numout,*) ' t_i_b : ', ( t_i_b(ji,layer1) , ! & layer1 = 1, nlay_i ) ! WRITE(numout,*) ' zqs : ', ( zqs(layer1) , ! & layer1 = 1, nlay_i ) ! WRITE(numout,*) ' zqt : ', ( zqt(layer1) , ! & layer1 = 1, nlay_i ) ENDIF !-----------------------------------------------------------------------------! ! 2) Weights !-----------------------------------------------------------------------------! ! DO layer1 = 1, nlay_bio DO layer0 = 1, nlay_i zweight(layer1,layer0) = MAX ( 0.0 , & ( MIN ( zb_i_phy(layer0) , & zb_i_bio(layer1) ) & - MAX ( zb_i_phy (layer0-1) , zb_i_bio(layer1-1) ) ) / & deltaz_i_phy(layer0) ) END DO END DO ! !-----------------------------------------------------------------------------! ! 3) Interpolation !-----------------------------------------------------------------------------! ! !-------------- ! Ice salinity !-------------- DO layer1 = 1, nlay_bio zq1(layer1) = 0.0 DO layer0 = 1, nlay_i zq1(layer1) = zq1(layer1) + zweight(layer1,layer0) * & zqs(layer0) END DO END DO IF ( ln_write ) THEN ! WRITE(numout,*) ' Salt contents ' ! WRITE(numout,*) ' zq1 : ', ( zq1(layer1) , ! & layer1 = 1, nlay_bio ) ENDIF DO layer1 = 1, nlay_bio s_i_bio(layer1) = zq1(layer1) / deltaz_i_bio(layer1) END DO IF ( ln_write ) THEN WRITE(numout,*) ' s_i_bio : ', ( s_i_bio(layer1) , & layer1 = 1, nlay_bio ) ENDIF !-------------- ! Heat content !-------------- DO layer1 = 1, nlay_bio zq1(layer1) = 0.0 DO layer0 = 1, nlay_i zq1(layer1) = zq1(layer1) + zweight(layer1,layer0) * & zqt(layer0) END DO END DO IF ( ln_write ) THEN ! WRITE(numout,*) ' Heat content ' ! WRITE(numout,*) ' zq1 : ', ( zq1(layer1) , ! & layer1 = 1, nlay_bio ) ENDIF ! Energy of melting DO layer1 = 1, nlay_bio zq1(layer1) = zq1(layer1) / deltaz_i_bio(layer1) END DO ! Invert energy of melting to get temperature back DO layer1 = 1, nlay_bio tmelts = - tmut * s_i_bio(layer1) + tpw zaaa = cpg zbbb = (cpw-cpg)*(tmelts-tpw) + zq1(layer1) / rhog & - lfus zccc = lfus * (tmelts-tpw) zdiscrim = SQRT( zbbb*zbbb - 4.0*zaaa*zccc ) t_i_bio(layer1) = tpw + ( - zbbb - zdiscrim ) / (2.0*zaaa) END DO IF ( ln_write ) THEN WRITE(numout,*) ' t_i_bio : ', ( t_i_bio(layer1) , & layer1 = 1, nlay_bio ) ENDIF !-------------- ! Brine volume !-------------- DO layer1 = 1, nlay_bio e_i_bio(layer1) = - tmut * s_i_bio(layer1) / & ( t_i_bio(layer1) - tpw ) END DO ! layer1 IF ( ln_write ) THEN WRITE(numout,*) ' e_i_bio : ', ( e_i_bio(layer1) , & layer1 = 1, nlay_bio ) ENDIF !-----------------------------------------------------------------------------! END DO ! ji !=============================================================================! !-- End of ice_bio_interp_phy2bio -- END ! !=============================================================================! !=============================================================================! ! SUBROUTINE ice_bio_interp_diffus(kideb,kiut,nlay_i,ln_write) INCLUDE 'type.com' INCLUDE 'para.com' INCLUDE 'const.com' INCLUDE 'ice.com' INCLUDE 'thermo.com' INCLUDE 'bio.com' INTEGER :: & ji , ! : index for space & jk , ! : index for ice layers & layer_bio , ! : & layer_phy , ! : & index_mem REAL(8), DIMENSION( 0:maxnlay ) :: ! lower interface of the layer & zz_phy REAL(8), DIMENSION( 0:nlay_bio ) :: ! lower interface of the layer & zz_bio LOGICAL :: & ln_write !=============================================================================! IF ( ln_write ) THEN WRITE(numout,*) ' *** ice_bio_interp_diffus : ' WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' ENDIF ! !-----------------------------------------------------------------------------! ! 1) Grids !-----------------------------------------------------------------------------! ! ! compute the coordinates of the interfaces of the layers ! zz_phy(0) = 0. DO layer_phy = 1, nlay_i zz_phy(layer_phy) = z_i_phy(layer_phy) + & deltaz_i_phy(layer_phy) / 2. END DO zz_bio(0) = 0. DO layer_bio = 1, nlay_bio zz_bio(layer_bio) = z_i_bio(layer_bio) + & deltaz_i_bio(layer_bio) / 2. END DO IF ( ln_write ) THEN WRITE(numout,*) ' zz_phy : ', ( zz_phy(layer_phy), & layer_phy = 0, nlay_i ) WRITE(numout,*) ' zz_bio : ', ( zz_bio(layer_bio), & layer_bio = 0, nlay_bio ) ENDIF DO layer_bio = 1, nlay_bio - 1 zdist_max = 999.9 zdist = zdist_max !WRITE(numout,*) ' ' !WRITE(numout,*) ' layer_bio : ', layer_bio DO layer_phy = 1, nlay_i zdist = MIN ( zdist, zz_bio(layer_bio) - zz_phy(layer_phy) ) IF ( ( zdist .GE. 0.0 ) .AND. ( zdist .LT. zdist_max ) ) & THEN index_mem = layer_phy ENDIF ! WRITE(numout,*) ' layer_phy : ', layer_phy ! WRITE(numout,*) ' zdist : ', zdist ! WRITE(numout,*) ' index_mem ', index_mem END DO ! layer_phy index_mem = MAX ( MIN( index_mem, nlay_i ) , 1 ) ! prevent absurd values sometimes reached in path cases zdummy1 = ( diff_br(index_mem+1) - diff_br(index_mem) ) / & ( zz_phy(index_mem+1) - zz_phy(index_mem) ) zdummy2 = zz_bio(layer_bio) - zz_phy(index_mem) !WRITE(numout,*) ' End of ze loupe ' !WRITE(numout,*) ' index_mem : ', index_mem diff_br_bio(layer_bio) = diff_br(index_mem) + zdummy1*zdummy2 END DO ! layer_bio diff_br_bio(nlay_bio) = diff_br(nlay_i) ! DO layer_bio = 1, nlay_bio ! diff_br_bio(layer_bio) = diff_br(layer_bio) ! END DO IF ( ln_write ) THEN WRITE(numout,*) WRITE(numout,*) ' diff_br : ', ( diff_br(layer_phy), & layer_phy = 1, nlay_i ) WRITE(numout,*) ' nlay_i : ', nlay_i WRITE(numout,*) ' nlay_bio : ', nlay_bio WRITE(numout,*) ' diff_br : ', ( diff_br(layer_phy), & layer_phy = 1, nlay_i ) WRITE(numout,*) ' diff_br_bio : ', ( diff_br_bio(layer_bio), & layer_bio = 1, nlay_bio ) ENDIF ! !=============================================================================! !-- End of ice_bio_interp_diff -- ! END