New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10288 for NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/TOP/PISCES/SED/sedmbc.F90 – NEMO

Ignore:
Timestamp:
2018-11-07T18:25:49+01:00 (5 years ago)
Author:
francesca
Message:

reduce global communications, see #2010

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2018/dev_r9866_HPC_03_globcom/src/TOP/PISCES/SED/sedmbc.F90

    r5215 r10288  
    11MODULE sedmbc 
    2 #if defined key_sed 
    32   !!====================================================================== 
    43   !!              ***  MODULE  sedmbc  *** 
     
    1211   USE sed     ! sediment global variable 
    1312   USE seddsr 
     13   USE lib_mpp         ! distribued memory computing library 
    1414 
    1515   IMPLICIT NONE 
     
    2727   REAL(wp), DIMENSION(jpwat) :: diss_in_tot   ! total input in pore water 
    2828   REAL(wp), DIMENSION(jpwat) :: diss_out_tot  ! total output from pore water 
    29  
    30    REAL(wp)  :: cons_tot_o2                   ! cumulative o2 consomation 
    31    REAL(wp)  :: sour_tot_no3                  ! cumulative no3 source 
    32    REAL(wp)  :: cons_tot_no3                  ! cumulative no3 consomation 
    33    REAL(wp)  :: sour_tot_c13                  ! cumulative o2 source 
    34  
    35    REAL(wp)  :: src13p   
    36    REAL(wp)  :: src13ca   
    3729 
    3830   !! $Id$ 
     
    6759      REAL, DIMENSION(jpwat) :: zpwcp_inv_i, zpwcp_inv_f 
    6860      REAL(wp) ::  zdelta_sil, zdelta_clay 
    69       REAL(wp) ::  zdelta_co2, zdelta_oxy 
     61      REAL(wp) ::  zdelta_co2, zdelta_fe 
    7062      REAL(wp) ::  zdelta_po4, zdelta_no3 
    71       REAL(wp) ::  zdelta_c13, zdelta_c13b 
    7263 
    7364      !!---------------------------------------------------------------------- 
    7465      ! Initilization 
    7566      !--------------- 
     67      IF( ln_timing )  CALL timing_start('sed_mbc') 
     68! 
    7669      IF( kt == nitsed000 ) THEN 
    77          cons_tot_o2  = 0. 
    78          sour_tot_no3 = 0. 
    79          cons_tot_no3 = 0. 
    80          sour_tot_c13 = 0. 
    8170 
    8271         DO js = 1, jpsol 
     
    9281         ENDDO 
    9382 
    94          src13p  = rc13P  * pdb 
    95          src13ca = rc13Ca * pdb 
    9683      ENDIF 
    9784 
     
    10693            ! input [mol] 
    10794            rain_tot   (js) = rain_tot   (js) + dtsed * rainrm_dta(ji,js) 
    108             fromsed_tot(js) = fromsed_tot(js) + fromsed(ji,js) 
     95            fromsed_tot(js) = fromsed_tot(js) + fromsed(ji,js) / mol_wgt(js) 
    10996            ! output [mol] 
    110             tosed_tot  (js) = tosed_tot (js) + tosed(ji,js) 
    111             rloss_tot  (js) = rloss_tot (js) + rloss(ji,js) 
     97            tosed_tot  (js) = tosed_tot (js) + tosed(ji,js) / mol_wgt(js) 
     98            rloss_tot  (js) = rloss_tot (js) + rloss(ji,js) / mol_wgt(js) 
    11299         ENDDO 
    113100      ENDDO 
     
    122109         ENDDO 
    123110      ENDDO 
    124  
    125       ! cumulativ o2 and no3 consomation 
    126       DO ji = 1, jpoce 
    127          cons_tot_o2  = cons_tot_o2  + cons_o2 (ji) 
    128          sour_tot_no3 = sour_tot_no3 + sour_no3(ji) 
    129          cons_tot_no3 = cons_tot_no3 + cons_no3(ji) 
    130          sour_tot_c13 = sour_tot_c13 + sour_c13(ji) 
    131       ENDDO 
    132       
    133111 
    134112      ! Mass balance check 
     
    141119         zpwcp_inv_f (:) = 0.         
    142120         DO js = 1, jpsol 
    143             zdsw = dens / mol_wgt(js) 
     121            zdsw = denssol / mol_wgt(js) 
    144122            DO jk = 2, jpksed 
    145123               DO ji = 1, jpoce 
     
    178156 
    179157         ! mass balance for carbon ( carbon in POC, CaCo3, DIC ) 
    180          zinit      = zsolcp_inv_i(jspoc) + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) 
    181          zfinal     = zsolcp_inv_f(jspoc) + zsolcp_inv_f(jscal) + zpwcp_inv_f(jwdic) 
    182          zinput     = rain_tot   (jspoc) + rain_tot   (jscal) + diss_in_tot(jwdic) 
    183          zoutput    = tosed_tot  (jspoc) + tosed_tot  (jscal) + diss_out_tot(jwdic) & 
    184             &       + rloss_tot  (jspoc) + rloss_tot  (jscal)  
     158         zinit      = zsolcp_inv_i(jspoc) + zsolcp_inv_i(jspos) + zsolcp_inv_i(jspor) & 
     159         &          + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) 
     160         zfinal     = zsolcp_inv_f(jspoc) + zsolcp_inv_f(jspos) + zsolcp_inv_f(jspor) & 
     161         &          + zsolcp_inv_f(jscal) + zpwcp_inv_f(jwdic) 
     162         zinput     = rain_tot (jspoc) + rain_tot   (jspos)  +  rain_tot   (jspor) & 
     163         &          + rain_tot (jscal) + diss_in_tot(jwdic) 
     164         zoutput    = tosed_tot(jspoc) + tosed_tot(jspos) + tosed_tot(jspor) + tosed_tot(jscal) + diss_out_tot(jwdic) & 
     165            &       + rloss_tot(jspoc) + rloss_tot(jspos) + rloss_tot(jspor) + rloss_tot(jscal)  
    185166         zdelta_co2 = ( zfinal + zoutput ) - ( zinit + zinput ) 
    186167 
    187          ! mass balance for oxygen : O2 is in POC remineralization 
    188          zinit      = zpwcp_inv_i(jwoxy) 
    189          zfinal     = zpwcp_inv_f(jwoxy) 
    190          zinput     = diss_in_tot(jwoxy) 
    191          zoutput    = diss_out_tot(jwoxy) + cons_tot_o2 
    192          zdelta_oxy = ( zfinal + zoutput ) - ( zinit + zinput ) 
    193  
    194          ! mass balance for phosphate ( PO4 in POC and dissolved phosphates ) 
    195          zinit      = zsolcp_inv_i(jspoc) * spo4r + zpwcp_inv_i(jwpo4) 
    196          zfinal     = zsolcp_inv_f(jspoc) * spo4r + zpwcp_inv_f(jwpo4) 
    197          zinput     = rain_tot   (jspoc) * spo4r + diss_in_tot(jwpo4) 
    198          zoutput    = tosed_tot  (jspoc) * spo4r + diss_out_tot(jwpo4) & 
    199             &       + rloss_tot  (jspoc) * spo4r 
    200          zdelta_po4 = ( zfinal + zoutput ) - ( zinit + zinput ) 
    201  
    202  
    203          ! mass balance for Nitrate 
    204          zinit      = zpwcp_inv_i  (jwno3) 
    205          zfinal     = zpwcp_inv_f  (jwno3) 
    206          zinput     = diss_in_tot (jwno3) + sour_tot_no3 
    207          zoutput    = diss_out_tot(jwno3) + cons_tot_no3 
     168         ! mass balance for Sulfur 
     169         zinit      = zpwcp_inv_i(jwso4) + zpwcp_inv_i(jwh2s)   & 
     170         &          + zsolcp_inv_i(jsfes)  
     171         zfinal     = zpwcp_inv_f(jwso4) + zpwcp_inv_f(jwh2s)   & 
     172         &          + zsolcp_inv_f(jsfes) 
     173         zinput     = diss_in_tot (jwso4) + diss_in_tot (jwh2s) & 
     174         &          + rain_tot (jsfes) 
     175         zoutput    = diss_out_tot(jwso4) + diss_out_tot(jwh2s) & 
     176         &          + tosed_tot(jsfes)    + rloss_tot(jsfes) 
    208177         zdelta_no3 = ( zfinal + zoutput ) - ( zinit + zinput ) 
    209178 
    210          ! mass balance for DIC13 
    211          zinit      =  zpwcp_inv_i(jwc13)   & 
    212             &        + src13p * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal)  
    213          zfinal     =  zpwcp_inv_f(jwc13)   & 
    214             &        + src13p * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal) 
    215          zinput     =  diss_in_tot (jwc13)  & 
    216             &        + src13p * rain_tot(jspoc) + src13Ca * rain_tot(jscal) 
    217          zoutput    =  diss_out_tot(jwc13)  & 
    218             &        + src13p * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) &    
    219             &        + src13p * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal) 
    220          zdelta_c13 = ( zfinal + zoutput ) - ( zinit + zinput ) 
    221  
    222          ! other mass balance for DIC13 
    223          zinit      = zpwcp_inv_i  (jwc13) 
    224          zfinal     = zpwcp_inv_f  (jwc13) 
    225          zinput     = diss_in_tot (jwc13) + sour_tot_c13 
    226          zoutput    = diss_out_tot(jwc13) 
    227          zdelta_c13b= ( zfinal + zoutput ) - ( zinit + zinput )     
     179         ! mass balance for iron 
     180         zinit      = zpwcp_inv_i(jwfe2)  + zsolcp_inv_i(jsfeo)   & 
     181         &          + zsolcp_inv_i(jsfes) 
     182         zfinal     = zpwcp_inv_f(jwfe2)  + zsolcp_inv_f(jsfeo)   & 
     183         &          + zsolcp_inv_f(jsfes) 
     184         zinput     = diss_in_tot (jwfe2) + rain_tot (jsfeo) & 
     185         &          + rain_tot (jsfes) 
     186         zoutput    = diss_out_tot(jwfe2) + tosed_tot(jsfeo) & 
     187         &          + tosed_tot(jsfes)    + rloss_tot(jsfes) + rloss_tot(jsfeo) 
     188         zdelta_fe  = ( zfinal + zoutput ) - ( zinit + zinput ) 
     189 
    228190 
    229191      END IF 
     
    231193      IF( kt == nitsedend) THEN  
    232194 
     195         IF (lwp) THEN 
    233196         WRITE(numsed,*) 
    234197         WRITE(numsed,*)'==================    General mass balance   ==================  ' 
    235198         WRITE(numsed,*)' ' 
    236199         WRITE(numsed,*)' ' 
    237          WRITE(numsed,*)' Initial total solid Masses (mole/dx.dy) (k=2-11) ' 
     200         WRITE(numsed,*)' Initial total solid Masses (mole/dx.dy)       ' 
    238201         WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    239          WRITE(numsed,*)'    Opale,      Clay,       POC,        CaCO3,         C13' 
    240          WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_i(jsopal),zsolcp_inv_i(jsclay),zsolcp_inv_i(jspoc), & 
    241             & zsolcp_inv_i(jscal),( src13P * zsolcp_inv_i(jspoc) + src13Ca * zsolcp_inv_i(jscal) ) 
    242          WRITE(numsed,*)' ' 
    243          WRITE(numsed,*)' Initial total dissolved Masses (mole/dx.dy) (k=2-11) ' 
     202         WRITE(numsed,*)'    Opal,      Clay,       POC,       POS,      POR,        CaCO3,     FeOH,     FeS' 
     203         WRITE(numsed,'(8x,4(1PE10.3,2X))')zsolcp_inv_i(jsopal),zsolcp_inv_i(jsclay),zsolcp_inv_i(jspoc), & 
     204            & zsolcp_inv_i(jspos),zsolcp_inv_i(jspor),zsolcp_inv_i(jscal),zsolcp_inv_i(jsfeo),zsolcp_inv_i(jsfes) 
     205         WRITE(numsed,*)' ' 
     206         WRITE(numsed,*)' Initial total dissolved Masses (mole/dx.dy)   ' 
    244207         WRITE(numsed,*)' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    245          WRITE(numsed,*)'    Si,         O2,         DIC,        Nit         Phos,       DIC13' 
    246          WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_i(jwsil), zpwcp_inv_i(jwoxy), & 
    247             & zpwcp_inv_i(jwdic), zpwcp_inv_i(jwno3), zpwcp_inv_i(jwpo4), zpwcp_inv_i(jwc13) 
    248          WRITE(numsed,*)' ' 
    249          WRITE(numsed,*)'  Solid inputs :  Opale,      Clay,       POC,        CaCO3,         C13' 
    250          WRITE(numsed,'(A4,10X,5(1PE10.3,2X))')'Rain : ',rain_tot(jsopal),rain_tot(jsclay),rain_tot(jspoc),& 
    251             & rain_tot(jscal),( src13P * rain_tot(jspoc) + src13Ca * rain_tot(jscal) ) 
    252          WRITE(numsed,'(A12,6x,4(1PE10.3,2X))')' From Sed : ',fromsed_tot(jsopal), fromsed_tot(jsclay), & 
    253             & fromsed_tot(jspoc), fromsed_tot(jscal) 
    254          WRITE(numsed,*)'Diss. inputs : Si,    O2,         DIC,         Nit,       Phos,       DIC13' 
     208         WRITE(numsed,*)'    Si,         O2,         DIC,        Nit,         Phos,         Fe2+' 
     209         WRITE(numsed,'(5x,5(1PE10.3,2X))') zpwcp_inv_i(jwsil), zpwcp_inv_i(jwoxy), & 
     210            & zpwcp_inv_i(jwdic), zpwcp_inv_i(jwno3), zpwcp_inv_i(jwpo4), zpwcp_inv_i(jwfe2) 
     211         WRITE(numsed,*)' ' 
     212         WRITE(numsed,*)'  Solid inputs :  Opale,      Clay,       POC,        CaCO3,        Fe' 
     213         WRITE(numsed,'(A4,10X,5(1PE10.3,2X))')'Rain : ',rain_tot(jsopal),rain_tot(jsclay),rain_tot(jspoc) + rain_tot(jspos) + rain_tot(jspor),& 
     214            & rain_tot(jscal), rain_tot(jsfeo) 
     215         WRITE(numsed,'(A12,6x,5(1PE10.3,2X))')' From Sed : ',fromsed_tot(jsopal), fromsed_tot(jsclay), & 
     216            & fromsed_tot(jspoc)+fromsed_tot(jspos)+fromsed_tot(jspor), fromsed_tot(jscal),    & 
     217            & fromsed_tot(jsfeo) + fromsed_tot(jsfes) 
     218         WRITE(numsed,*)'Diss. inputs : Si,    O2,         DIC,         Nit,       Phos,      Fe' 
    255219         WRITE(numsed,'(A9,1x,6(1PE10.3,2X))')' From Pisc : ', diss_in_tot(jwsil), & 
    256             & diss_in_tot(jwoxy), diss_in_tot(jwdic), diss_in_tot(jwno3), diss_in_tot(jwpo4), & 
    257             & diss_in_tot(jwc13) 
    258          WRITE(numsed,*)' ' 
    259          WRITE(numsed,*)'Solid output : Opale,      Clay,       POC,        CaCO3,          C13' 
    260          WRITE(numsed,'(A6,8x,5(1PE10.3,2X))')'To sed', tosed_tot(jsopal),tosed_tot(jsclay),tosed_tot(jspoc),& 
    261             & tosed_tot(jscal),( src13P * tosed_tot(jspoc) + src13Ca * tosed_tot(jscal) ) 
    262          WRITE(numsed,'(A5,9x,5(1PE10.3,2X))')'Perdu', rloss_tot(jsopal),rloss_tot(jsclay),rloss_tot(jspoc),& 
    263             & rloss_tot(jscal),( src13P * rloss_tot(jspoc) + src13Ca * rloss_tot(jscal) ) 
    264          WRITE(numsed,*)'Diss. output : Si,     O2,        DIC,          Nit,       Phos,       DIC13 '   
     220            & diss_in_tot(jwoxy), diss_in_tot(jwdic), diss_in_tot(jwno3), diss_in_tot(jwpo4), diss_in_tot(jwfe2) 
     221         WRITE(numsed,*)' ' 
     222         WRITE(numsed,*)'Solid output : Opale,      Clay,       POC,        CaCO3,        Fe' 
     223         WRITE(numsed,'(A6,8x,5(1PE10.3,2X))')'To sed', tosed_tot(jsopal),tosed_tot(jsclay),tosed_tot(jspoc) & 
     224            & +tosed_tot(jspos)+tosed_tot(jspor),tosed_tot(jscal), tosed_tot(jsfeo)+tosed_tot(jsfes) 
     225         WRITE(numsed,'(A5,9x,5(1PE10.3,2X))')'Perdu', rloss_tot(jsopal),rloss_tot(jsclay),rloss_tot(jspoc) & 
     226            & +rloss_tot(jspos)+rloss_tot(jspor),rloss_tot(jscal),rloss_tot(jsfeo)+rloss_tot(jsfes) 
     227         WRITE(numsed,*)'Diss. output : Si,     O2,        DIC,          Nit,       Phos,        Fe '   
    265228         WRITE(numsed,'(A7,2x,6(1PE10.3,2X))')'To kbot', diss_out_tot(jwsil), & 
    266             & diss_out_tot(jwoxy), diss_out_tot(jwdic), diss_out_tot(jwno3), diss_out_tot(jwpo4), & 
    267             & diss_out_tot(jwc13) 
    268          WRITE(numsed,*)' ' 
    269          WRITE(numsed,*)' Total consomation in POC remineralization [mol]:  O2,         NO3' 
    270          WRITE(numsed,'(51x,2(1PE10.3,2X))') cons_tot_o2,cons_tot_no3 
    271          WRITE(numsed,*)' ' 
    272          WRITE(numsed,*)'Final solid  Masses (mole/dx.dy) (k=2-11)' 
    273          WRITE(numsed,*)'    Opale,      Clay,       POC,        CaCO3,          C13' 
    274          WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_f(jsopal),zsolcp_inv_f(jsclay),zsolcp_inv_f(jspoc), & 
    275             & zsolcp_inv_f(jscal),( src13P * zsolcp_inv_f(jspoc) + src13Ca * zsolcp_inv_f(jscal) ) 
     229            & diss_out_tot(jwoxy), diss_out_tot(jwdic), diss_out_tot(jwno3), diss_out_tot(jwpo4), diss_out_tot(jwfe2) 
     230         WRITE(numsed,*)' ' 
     231         WRITE(numsed,*)'Final solid  Masses (mole/dx.dy) ' 
     232         WRITE(numsed,*)'    Opale,      Clay,       POC,        CaCO3,      Fe' 
     233         WRITE(numsed,'(4x,5(1PE10.3,2X))')zsolcp_inv_f(jsopal),zsolcp_inv_f(jsclay),zsolcp_inv_f(jspoc)  & 
     234            & +zsolcp_inv_f(jspos)+zsolcp_inv_f(jspor),zsolcp_inv_f(jscal),zsolcp_inv_f(jsfeo)+zsolcp_inv_f(jsfes) 
    276235         WRITE(numsed,*)' ' 
    277236         WRITE(numsed,*)'Final dissolved  Masses (mole/dx.dy) (k=2-11)' 
    278          WRITE(numsed,*)'    Si,        O2,         DIC,        Nit,        Phos,    DIC13' 
     237         WRITE(numsed,*)'    Si,        O2,         DIC,        Nit,        Phos,        Fe' 
    279238         WRITE(numsed,'(4x,6(1PE10.3,2X))') zpwcp_inv_f(jwsil), zpwcp_inv_f(jwoxy), & 
    280             & zpwcp_inv_f(jwdic), zpwcp_inv_f(jwno3), zpwcp_inv_f(jwpo4), zpwcp_inv_f(jwc13) 
     239            & zpwcp_inv_f(jwdic), zpwcp_inv_f(jwno3), zpwcp_inv_f(jwpo4), zpwcp_inv_f(jwfe2) 
    281240         WRITE(numsed,*)' '      
    282          WRITE(numsed,*)'Delta : Opale,      Clay,       C,          O,          N,          P,        C13' 
    283          WRITE(numsed,'(7x,7(1PE11.3,1X))') zdelta_sil, zdelta_clay, zdelta_co2, zdelta_oxy, zdelta_no3,& 
    284             &                          zdelta_po4, zdelta_c13 
    285          WRITE(numsed,*)' '  
    286          WRITE(numsed,*)'deltaC13bis : ',zdelta_c13b      
    287  
     241         WRITE(numsed,*)'Delta : Opale,      Clay,       C,         Fe,          S,' 
     242         WRITE(numsed,'(7x,6(1PE11.3,1X))') zdelta_sil / ( zsolcp_inv_i(jsopal) + zpwcp_inv_i(jwsil) ) , & 
     243         &            zdelta_clay / ( zsolcp_inv_i(jsclay) ) ,      &  
     244         &            zdelta_co2 / ( zsolcp_inv_i(jspoc) + zsolcp_inv_i(jspos) + zsolcp_inv_i(jspor) & 
     245         &          + zsolcp_inv_i(jscal) + zpwcp_inv_i(jwdic) ),     & 
     246         &            zdelta_fe / ( zpwcp_inv_i(jwfe2) + zsolcp_inv_i(jsfeo) + zsolcp_inv_i(jsfes) ) ,  & 
     247         &            zdelta_no3 / ( zpwcp_inv_i(jwso4) + zpwcp_inv_i(jwh2s) + zsolcp_inv_i(jsfes) ) 
    288248         WRITE(numsed,*)'==========================================================================' 
    289          WRITE(numsed,*)' Composition of final sediment for point jpoce' 
    290          WRITE(numsed,*)' =========================================' 
    291          WRITE(numsed,*)'Opale,      Clay,       POC,        CaCo3,      hipor,      pH,         co3por' 
    292          DO jk = 1,jpksed 
    293             WRITE(numsed,'(4(F8.4,4X),3(1PE10.3,2X))') solcp(jpoce,jk,jsopal)*100.,solcp(jpoce,jk,jsclay)*100.,& 
    294                &       solcp(jpoce,jk,jspoc)*100.,solcp(jpoce,jk,jscal)*100.,& 
    295                &       hipor(jpoce,jk),-LOG10(hipor(jpoce,jk)/densSW(jpoce)),co3por(jpoce,jk) 
    296          ENDDO 
    297          WRITE(numsed,*)'Silicic A.,  Oxygen,     DIC,        Nitrats,    Phosphats,  Alkal.,     DIC13' 
    298          DO jk = 1, jpksed 
    299             WRITE(numsed,'(8(1PE10.3,2X))')pwcp(jpoce,jk,jwsil),pwcp(jpoce,jk,jwoxy),& 
    300                & pwcp(jpoce,jk,jwdic),pwcp(jpoce,jk,jwno3),pwcp(jpoce,jk,jwpo4),pwcp(jpoce,jk,jwalk),pwcp(jpoce,jk,jwc13) 
    301          ENDDO 
    302          WRITE(numsed,*)'densSW at the end : ',densSW(jpoce) 
    303          WRITE(numsed,*)'==========================================================================' 
    304249 
    305250      ENDIF 
     251      ENDIF 
     252 
     253      IF( ln_timing )  CALL timing_stop('sed_mbc') 
    306254   
    307255   END SUBROUTINE sed_mbc 
    308256 
    309  
    310 #else 
    311    !!====================================================================== 
    312    !! MODULE sedmbc :   Dummy module  
    313    !!====================================================================== 
    314    !! $Id$ 
    315 CONTAINS 
    316    SUBROUTINE sed_mbc( kt )         ! Empty routine 
    317       INTEGER, INTENT(in) :: kt 
    318       WRITE(*,*) 'sed_mbc: You should not have seen this print! error?', kt 
    319    END SUBROUTINE sed_mbc 
    320 #endif 
    321257END MODULE sedmbc 
Note: See TracChangeset for help on using the changeset viewer.