Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
Mar 30, 2011 9:31:40 AM (13 years ago)
Author:
raasch
Message:

formatting adjustments

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/surface_coupler.f90

    r668 r709  
    44! Current revisions:
    55! -----------------
     6! formatting adjustments
    67!
    78! Former revisions:
    … …  
    1011!
    1112! 667 2010-12-23 12:06:00Z suehring/gryschka
    12 ! additional case for nonequivalent processor and grid topopolgy in ocean and
    13 ! atmosphere added (coupling_topology = 1)
     13! Additional case for nonequivalent processor and grid topopolgy in ocean and
     14! atmosphere added (coupling_topology = 1).
    1415! Added exchange of u and v from Ocean to Atmosphere
    1516!
    … …  
    6061
    6162    IF ( coupling_topology == 0 ) THEN
    62        CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, target_id,  &
    63                           0,                                                    &
    64                           terminate_coupled_remote, 1, MPI_INTEGER, target_id,  &
     63       CALL MPI_SENDRECV( terminate_coupled,        1, MPI_INTEGER, target_id, &
     64                          0,                                                   &
     65                          terminate_coupled_remote, 1, MPI_INTEGER, target_id, &
    6566                          0, comm_inter, status, ierr )
    6667    ELSE
    … …  
    7273                             comm_inter, status, ierr )
    7374       ENDIF
    74        CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, ierr)
     75       CALL MPI_BCAST( terminate_coupled_remote, 1, MPI_INTEGER, 0, comm2d, &
     76                       ierr )
    7577
    7678       ALLOCATE( total_2d_a(-nbgp:ny_a+nbgp,-nbgp:nx_a+nbgp),       &
    … …  
    9799!-- Exchange the current simulated time between the models,
    98100!-- currently just for total_2ding
    99     IF ( coupling_topology == 0 ) THEN   
    100        CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, &
    101                       target_id, 11, comm_inter, ierr )
    102        CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, &
    103                       target_id, 11, comm_inter, status, ierr )
     101    IF ( coupling_topology == 0 ) THEN
     102   
     103       CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, 11, &
     104                      comm_inter, ierr )
     105       CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, target_id, &
     106                      11, comm_inter, status, ierr )
    104107    ELSE
     108
    105109       IF ( myid == 0 ) THEN
    106           CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, &
    107                          target_id, 11, comm_inter, ierr )
    108           CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL, &
     110
     111          CALL MPI_SEND( time_since_reference_point, 1, MPI_REAL, target_id, &
     112                         11, comm_inter, ierr )
     113          CALL MPI_RECV( time_since_reference_point_rem, 1, MPI_REAL,        &
    109114                         target_id, 11, comm_inter, status, ierr )
     115
    110116       ENDIF
    111        CALL MPI_BCAST( time_since_reference_point_rem, 1, MPI_REAL, &
    112                        0, comm2d, ierr )
    113     ENDIF
    114     WRITE ( 9, * ) 'simulated time: ', simulated_time
    115     WRITE ( 9, * ) 'time since start of coupling: ', &
    116                   time_since_reference_point, ' remote: ', &
    117                   time_since_reference_point_rem
    118    CALL local_flush( 9 )
    119  
     117
     118       CALL MPI_BCAST( time_since_reference_point_rem, 1, MPI_REAL, 0, comm2d, &
     119                       ierr )
     120
     121    ENDIF
    120122
    121123!
    … …  
    124126   
    125127!
    126 !--    Horizontal grid size and number of processors is equal
    127 !--    in ocean and atmosphere
    128        IF ( coupling_topology == 0 ) THEN
    129 
    130 !
    131 !--       Send heat flux at bottom surface to the ocean model
    132           CALL MPI_SEND( shf(nysg,nxlg), ngp_xy, MPI_REAL, &
    133                          target_id, 12, comm_inter, ierr )
    134 
    135 !
    136 !--       Send humidity flux at bottom surface to the ocean model
     128!--    Horizontal grid size and number of processors is equal in ocean and
     129!--    atmosphere
     130       IF ( coupling_topology == 0 )  THEN
     131
     132!
     133!--       Send heat flux at bottom surface to the ocean
     134          CALL MPI_SEND( shf(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 12, &
     135                         comm_inter, ierr )
     136!
     137!--       Send humidity flux at bottom surface to the ocean
    137138          IF ( humidity )  THEN
    138              CALL MPI_SEND( qsws(nysg,nxlg), ngp_xy, MPI_REAL, &
    139                             target_id, 13, comm_inter, ierr )
    140           ENDIF
    141 
    142 !
    143 !--       Receive temperature at the bottom surface from the ocean model
    144           WRITE ( 9, * )  '*** receive pt from ocean'
    145           CALL local_flush( 9 )
    146           CALL MPI_RECV( pt(0,nysg,nxlg), 1, type_xy, &
    147                          target_id, 14, comm_inter, status, ierr )
    148 
    149 !
    150 !--       Send the momentum flux (u) at bottom surface to the ocean model
    151           CALL MPI_SEND( usws(nysg,nxlg), ngp_xy, MPI_REAL, &
    152                          target_id, 15, comm_inter, ierr )
    153 
    154 !
    155 !--       Send the momentum flux (v) at bottom surface to the ocean model
    156           CALL MPI_SEND( vsws(nysg,nxlg), ngp_xy, MPI_REAL, &
    157                          target_id, 16, comm_inter, ierr )
    158 
    159 !
    160 !--       Receive u at the bottom surface from the ocean model
    161           CALL MPI_RECV( u(0,nysg,nxlg), 1, type_xy, &
    162                          target_id, 17, comm_inter, status, ierr )
    163 
    164 !
    165 !--       Receive v at the bottom surface from the ocean model
    166           CALL MPI_RECV( v(0,nysg,nxlg), 1, type_xy, &
    167                          target_id, 18,  comm_inter, status, ierr )
    168 
     139             CALL MPI_SEND( qsws(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 13, &
     140                            comm_inter, ierr )
     141          ENDIF
     142!
     143!--       Receive temperature at the bottom surface from the ocean
     144          CALL MPI_RECV( pt(0,nysg,nxlg), 1, type_xy, target_id, 14, &
     145                         comm_inter, status, ierr )
     146!
     147!--       Send the momentum flux (u) at bottom surface to the ocean
     148          CALL MPI_SEND( usws(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 15, &
     149                         comm_inter, ierr )
     150!
     151!--       Send the momentum flux (v) at bottom surface to the ocean
     152          CALL MPI_SEND( vsws(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 16, &
     153                         comm_inter, ierr )
     154!
     155!--       Receive u at the bottom surface from the ocean
     156          CALL MPI_RECV( u(0,nysg,nxlg), 1, type_xy, target_id, 17, &
     157                         comm_inter, status, ierr )
     158!
     159!--       Receive v at the bottom surface from the ocean
     160          CALL MPI_RECV( v(0,nysg,nxlg), 1, type_xy, target_id, 18, &
     161                         comm_inter, status, ierr )
    169162!
    170163!--    Horizontal grid size or number of processors differs between
    … …  
    173166     
    174167!
    175 !--       Send heat flux at bottom surface to the ocean model
     168!--       Send heat flux at bottom surface to the ocean
    176169          total_2d_a = 0.0
    177           total_2d = 0.0
     170          total_2d   = 0.0
    178171          total_2d(nys:nyn,nxl:nxr) = shf(nys:nyn,nxl:nxr)
    179           CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
    180                            MPI_SUM, 0, comm2d, ierr )
    181           CALL interpolate_to_ocean(12)
    182    
    183 !
    184 !--       Send humidity flux at bottom surface to the ocean model
    185           IF ( humidity ) THEN
     172
     173          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, &
     174                           comm2d, ierr )
     175          CALL interpolate_to_ocean( 12 )   
     176!
     177!--       Send humidity flux at bottom surface to the ocean
     178          IF ( humidity )  THEN
    186179             total_2d_a = 0.0
    187              total_2d = 0.0
     180             total_2d   = 0.0
    188181             total_2d(nys:nyn,nxl:nxr) = qsws(nys:nyn,nxl:nxr)
    189              CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
    190                               MPI_SUM, 0, comm2d, ierr )
    191              CALL interpolate_to_ocean(13)
    192           ENDIF
    193 
    194 !
    195 !--       Receive temperature at the bottom surface from the ocean model
    196           IF ( myid == 0 ) THEN
     182
     183             CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, &
     184                              0, comm2d, ierr )
     185             CALL interpolate_to_ocean( 13 )
     186          ENDIF
     187!
     188!--       Receive temperature at the bottom surface from the ocean
     189          IF ( myid == 0 )  THEN
    197190             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    198191                            target_id, 14, comm_inter, status, ierr )   
    199192          ENDIF
    200193          CALL MPI_BARRIER( comm2d, ierr )
    201           CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    202                           0, comm2d, ierr )
     194          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
     195                          ierr )
    203196          pt(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
    204 
    205 !
    206 !--       Send momentum flux (u) at bottom surface to the ocean model
     197!
     198!--       Send momentum flux (u) at bottom surface to the ocean
    207199          total_2d_a = 0.0
    208           total_2d = 0.0
     200          total_2d   = 0.0
    209201          total_2d(nys:nyn,nxl:nxr) = usws(nys:nyn,nxl:nxr)
    210           CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
    211                            MPI_SUM, 0, comm2d, ierr )
    212           CALL interpolate_to_ocean(15)
    213 
    214 !
    215 !--       Send momentum flux (v) at bottom surface to the ocean model
     202          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, &
     203                           comm2d, ierr )
     204          CALL interpolate_to_ocean( 15 )
     205!
     206!--       Send momentum flux (v) at bottom surface to the ocean
    216207          total_2d_a = 0.0
    217           total_2d = 0.0
     208          total_2d   = 0.0
    218209          total_2d(nys:nyn,nxl:nxr) = vsws(nys:nyn,nxl:nxr)
    219           CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, &
    220                            MPI_SUM, 0, comm2d, ierr )
    221           CALL interpolate_to_ocean(16)
    222 
    223 !
    224 !--       Receive u at the bottom surface from the ocean model
    225           IF ( myid == 0 ) THEN
     210          CALL MPI_REDUCE( total_2d, total_2d_a, ngp_a, MPI_REAL, MPI_SUM, 0, &
     211                           comm2d, ierr )
     212          CALL interpolate_to_ocean( 16 )
     213!
     214!--       Receive u at the bottom surface from the ocean
     215          IF ( myid == 0 )  THEN
    226216             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    227                             target_id, 17, comm_inter, status, ierr )           
     217                            target_id, 17, comm_inter, status, ierr )
    228218          ENDIF
    229219          CALL MPI_BARRIER( comm2d, ierr )
    230           CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    231                           0, comm2d, ierr )
     220          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
     221                          ierr )
    232222          u(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
    233    
    234 !
    235 !--       Receive v at the bottom surface from the ocean model
    236           IF ( myid == 0 ) THEN
     223!
     224!--       Receive v at the bottom surface from the ocean
     225          IF ( myid == 0 )  THEN
    237226             CALL MPI_RECV( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    238                             target_id, 18, comm_inter, status, ierr )           
     227                            target_id, 18, comm_inter, status, ierr )
    239228          ENDIF
    240229          CALL MPI_BARRIER( comm2d, ierr )
    241           CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    242                           0, comm2d, ierr )
     230          CALL MPI_BCAST( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, 0, comm2d, &
     231                          ierr )
    243232          v(0,nysg:nyng,nxlg:nxrg) = total_2d_a(nysg:nyng,nxlg:nxrg)
    244233
    … …  
    252241       IF ( coupling_topology == 0 ) THEN
    253242!
    254 !--       Receive heat flux at the sea surface (top) from the atmosphere model
    255           CALL MPI_RECV( tswst(nysg,nxlg), ngp_xy, MPI_REAL, &
    256                          target_id, 12, comm_inter, status, ierr )
    257 
    258 
    259 !
    260 !--       Receive humidity flux from the atmosphere model (bottom)
     243!--       Receive heat flux at the sea surface (top) from the atmosphere
     244          CALL MPI_RECV( tswst(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 12, &
     245                         comm_inter, status, ierr )
     246!
     247!--       Receive humidity flux from the atmosphere (bottom)
    261248!--       and add it to the heat flux at the sea surface (top)...
    262249          IF ( humidity_remote )  THEN
    263250             CALL MPI_RECV( qswst_remote(nysg,nxlg), ngp_xy, MPI_REAL, &
    264251                            target_id, 13, comm_inter, status, ierr )
    265 
    266           ENDIF
    267 
     252          ENDIF
    268253!
    269254!--       Send sea surface temperature to the atmosphere model
    270           CALL MPI_SEND( pt(nzt,nysg,nxlg), 1, type_xy, &
    271                          target_id, 14, comm_inter, ierr )
    272 
     255          CALL MPI_SEND( pt(nzt,nysg,nxlg), 1, type_xy, target_id, 14, &
     256                         comm_inter, ierr )
    273257!
    274258!--       Receive momentum flux (u) at the sea surface (top) from the atmosphere
    275 !--       model
    276           WRITE ( 9, * )  '*** receive uswst from atmosphere'
    277           CALL local_flush( 9 )
    278           CALL MPI_RECV( uswst(nysg,nxlg), ngp_xy, MPI_REAL, &
    279                          target_id, 15, comm_inter, status, ierr )
    280 
     259          CALL MPI_RECV( uswst(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 15, &
     260                         comm_inter, status, ierr )
    281261!
    282262!--       Receive momentum flux (v) at the sea surface (top) from the atmosphere
    283 !--       model
    284           CALL MPI_RECV( vswst(nysg,nxlg), ngp_xy, MPI_REAL, &
    285                          target_id, 16, comm_inter, status, ierr )
    286 
    287 !--       Send u to the atmosphere model
    288           CALL MPI_SEND( u(nzt,nysg,nxlg), 1, type_xy, &
    289                          target_id, 17, comm_inter, ierr )
    290 
    291 !
    292 !--       Send v to the atmosphere model
    293           CALL MPI_SEND( v(nzt,nysg,nxlg), 1, type_xy, &
    294                          target_id, 18, comm_inter, ierr )
    295 
     263          CALL MPI_RECV( vswst(nysg,nxlg), ngp_xy, MPI_REAL, target_id, 16, &
     264                         comm_inter, status, ierr )
     265!
     266!--       Send u to the atmosphere
     267          CALL MPI_SEND( u(nzt,nysg,nxlg), 1, type_xy, target_id, 17, &
     268                         comm_inter, ierr )
     269!
     270!--       Send v to the atmosphere
     271          CALL MPI_SEND( v(nzt,nysg,nxlg), 1, type_xy, target_id, 18, &
     272                         comm_inter, ierr )
    296273!
    297274!--    Horizontal gridsize or number of processors differs between
    298275!--    ocean and atmosphere
    299276       ELSE
    300 
    301 !
    302 !--       Receive heat flux at the sea surface (top) from the atmosphere model
    303           IF ( myid == 0 ) THEN
     277!
     278!--       Receive heat flux at the sea surface (top) from the atmosphere
     279          IF ( myid == 0 )  THEN
    304280             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    305                             target_id, 12, comm_inter, status, ierr )           
     281                            target_id, 12, comm_inter, status, ierr )
     282          ENDIF
     283          CALL MPI_BARRIER( comm2d, ierr )
     284          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, comm2d, &
     285                          ierr )
     286          tswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     287!
     288!--       Receive humidity flux at the sea surface (top) from the atmosphere
     289          IF ( humidity_remote )  THEN
     290             IF ( myid == 0 )  THEN
     291                CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     292                               target_id, 13, comm_inter, status, ierr )
     293             ENDIF
     294             CALL MPI_BARRIER( comm2d, ierr )
     295             CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, &
     296                             comm2d, ierr)
     297             qswst_remote(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     298          ENDIF
     299!
     300!--       Send surface temperature to atmosphere
     301          total_2d_o = 0.0
     302          total_2d   = 0.0
     303          total_2d(nys:nyn,nxl:nxr) = pt(nzt,nys:nyn,nxl:nxr)
     304
     305          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
     306                           comm2d, ierr)
     307          CALL interpolate_to_atmos( 14 )
     308!
     309!--       Receive momentum flux (u) at the sea surface (top) from the atmosphere
     310          IF ( myid == 0 )  THEN
     311             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
     312                            target_id, 15, comm_inter, status, ierr )
    306313          ENDIF
    307314          CALL MPI_BARRIER( comm2d, ierr )
    308315          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    309                           0, comm2d, ierr)
    310           tswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
    311 
    312 !
    313 !--       Receive humidity flux at the sea surface (top) from the
    314 !--       atmosphere model
    315           IF ( humidity_remote ) THEN
    316              IF ( myid == 0 ) THEN
    317                 CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    318                                target_id, 13, comm_inter, status, ierr )           
    319              ENDIF
    320              CALL MPI_BARRIER( comm2d, ierr )
    321              CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    322                              0, comm2d, ierr)
    323              qswst_remote(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
    324           ENDIF
    325 
    326 !
    327 !--       Send surface temperature to atmosphere
    328           total_2d_o = 0.0
    329           total_2d = 0.0
    330           total_2d(nys:nyn,nxl:nxr) = pt(nzt,nys:nyn,nxl:nxr)
    331 
    332           CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, &
    333                           MPI_REAL, MPI_SUM, 0, comm2d, ierr)
    334 
    335           CALL interpolate_to_atmos(14)
    336 
    337 !
    338 !--       Receive momentum flux (u) at the sea surface (top) from the
    339 !--       atmosphere model
    340           IF ( myid == 0 ) THEN
     316                          0, comm2d, ierr )
     317          uswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
     318!
     319!--       Receive momentum flux (v) at the sea surface (top) from the atmosphere
     320          IF ( myid == 0 )  THEN
    341321             CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    342                             target_id, 15, comm_inter, status, ierr )           
     322                            target_id, 16, comm_inter, status, ierr )
    343323          ENDIF
    344324          CALL MPI_BARRIER( comm2d, ierr )
    345           CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    346                           0, comm2d, ierr)
    347           uswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
    348 
    349 !
    350 !--       Receive momentum flux (v) at the sea surface (top) from the
    351 !--       atmosphere model
    352           IF ( myid == 0 ) THEN
    353              CALL MPI_RECV( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    354                             target_id, 16, comm_inter, status, ierr )           
    355           ENDIF
    356           CALL MPI_BARRIER( comm2d, ierr )
    357           CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
    358                           0, comm2d, ierr)
     325          CALL MPI_BCAST( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, 0, comm2d, &
     326                          ierr )
    359327          vswst(nysg:nyng,nxlg:nxrg) = total_2d_o(nysg:nyng,nxlg:nxrg)
    360 
    361328!
    362329!--       Send u to atmosphere
    363330          total_2d_o = 0.0 
    364           total_2d = 0.0
     331          total_2d   = 0.0
    365332          total_2d(nys:nyn,nxl:nxr) = u(nzt,nys:nyn,nxl:nxr)
    366           CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, MPI_REAL, &
    367                           MPI_SUM, 0, comm2d, ierr) 
    368           CALL interpolate_to_atmos(17)
    369 
     333          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
     334                           comm2d, ierr )
     335          CALL interpolate_to_atmos( 17 )
    370336!
    371337!--       Send v to atmosphere
    372338          total_2d_o = 0.0
    373           total_2d = 0.0
     339          total_2d   = 0.0
    374340          total_2d(nys:nyn,nxl:nxr) = v(nzt,nys:nyn,nxl:nxr)
    375           CALL MPI_REDUCE(total_2d, total_2d_o, ngp_o, MPI_REAL, &
    376                           MPI_SUM, 0, comm2d, ierr) 
    377           CALL interpolate_to_atmos(18)
     341          CALL MPI_REDUCE( total_2d, total_2d_o, ngp_o, MPI_REAL, MPI_SUM, 0, &
     342                           comm2d, ierr )
     343          CALL interpolate_to_atmos( 18 )
    378344       
    379345       ENDIF
    … …  
    382348!--    Conversions of fluxes received from atmosphere
    383349       IF ( humidity_remote )  THEN
    384           !here tswst is still the sum of atmospheric bottom heat fluxes
    385           tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0
    386           !*latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
    387           !/(rho_atm(=1.0)*c_p)
     350!
     351!--       Here tswst is still the sum of atmospheric bottom heat fluxes,
     352!--       * latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol
     353!--       /(rho_atm(=1.0)*c_p)
     354          tswst = tswst + qswst_remote * 2.2626108E6 / 1005.0
    388355!
    389356!--        ...and convert it to a salinity flux at the sea surface (top)
    … …  
    405372       vswst = vswst / rho(nzt,:,:)
    406373
    407 
    408     ENDIF
    409 
    410     IF ( coupling_topology == 1 ) THEN
     374    ENDIF
     375
     376    IF ( coupling_topology == 1 )  THEN
    411377       DEALLOCATE( total_2d_o, total_2d_a )
    412378    ENDIF
    … …  
    420386
    421387
    422   SUBROUTINE interpolate_to_atmos(tag)
     388  SUBROUTINE interpolate_to_atmos( tag )
    423389
    424390    USE arrays_3d
    … …  
    430396    IMPLICIT NONE
    431397
    432  
    433398    INTEGER             ::  dnx, dnx2, dny, dny2, i, ii, j, jj
    434399    INTEGER, intent(in) ::  tag
    … …  
    436401    CALL MPI_BARRIER( comm2d, ierr )
    437402
    438     IF ( myid == 0 ) THEN
    439 
    440 !
    441 !--    cyclic boundary conditions for the total 2D-grid
     403    IF ( myid == 0 )  THEN
     404!
     405!--    Cyclic boundary conditions for the total 2D-grid
    442406       total_2d_o(-nbgp:-1,:) = total_2d_o(ny+1-nbgp:ny,:)
    443407       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx+1-nbgp:nx)
    … …  
    452416
    453417!
    454 !--    Distance for interpolation around coarse grid points within the fine grid
    455 !--    (note: 2*dnx2 must not be equal with dnx) 
     418!--    Distance for interpolation around coarse grid points within the fine
     419!--    grid (note: 2*dnx2 must not be equal with dnx)
    456420       dnx2 = 2 * ( dnx / 2 )
    457421       dny2 = 2 * ( dny / 2 )
    … …  
    472436       ENDDO
    473437!
    474 !--    cyclic boundary conditions for atmosphere grid
     438!--    Cyclic boundary conditions for atmosphere grid
    475439       total_2d_a(-nbgp:-1,:) = total_2d_a(ny_a+1-nbgp:ny_a,:)
    476440       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx_a+1-nbgp:nx_a)
    … …  
    480444!
    481445!--    Transfer of the atmosphere-grid-layer to the atmosphere
    482        CALL MPI_SEND( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, &
    483                       target_id, tag, comm_inter, ierr )
     446       CALL MPI_SEND( total_2d_a(-nbgp,-nbgp), ngp_a, MPI_REAL, target_id, &
     447                      tag, comm_inter, ierr )
    484448
    485449    ENDIF
    … …  
    490454
    491455
    492   SUBROUTINE interpolate_to_ocean(tag)
     456  SUBROUTINE interpolate_to_ocean( tag )
    493457
    494458    USE arrays_3d
    … …  
    500464    IMPLICIT NONE
    501465
    502     REAL                ::  fl, fr, myl, myr
    503466    INTEGER             ::  dnx, dny, i, ii, j, jj
    504467    INTEGER, intent(in) ::  tag
     468    REAL                ::  fl, fr, myl, myr
     469
    505470
    506471    CALL MPI_BARRIER( comm2d, ierr )
    507472
    508     IF ( myid == 0 ) THEN   
    509 
    510 !
    511 !      Number of gridpoints of the fine grid within one mesh of the coarse grid
     473    IF ( myid == 0 )  THEN   
     474
     475!
     476!--    Number of gridpoints of the fine grid within one mesh of the coarse grid
    512477       dnx = ( nx_o + 1 ) / ( nx_a + 1 )
    513478       dny = ( ny_o + 1 ) / ( ny_a + 1 )
    514479
    515480!
    516 !--    cyclic boundary conditions for atmosphere grid
     481!--    Cyclic boundary conditions for atmosphere grid
    517482       total_2d_a(-nbgp:-1,:) = total_2d_a(ny+1-nbgp:ny,:)
    518483       total_2d_a(:,-nbgp:-1) = total_2d_a(:,nx+1-nbgp:nx)
    … …  
    521486       total_2d_a(:,nx+1:nx+nbgp) = total_2d_a(:,0:nbgp-1)
    522487!
    523 !--    Bilinear Interpolation from atmosphere-grid-layer to ocean-grid-layer
     488!--    Bilinear Interpolation from atmosphere grid-layer to ocean grid-layer
    524489       DO  j = 0, ny
    525490          DO  i = 0, nx
    … …  
    527492             myr = ( total_2d_a(j+1,i+1) - total_2d_a(j,i+1) ) / dny
    528493             DO  jj = 0, dny-1
    529                 fl = myl*jj  + total_2d_a(j,i) 
    530                 fr = myr*jj  + total_2d_a(j,i+1) 
     494                fl = myl*jj + total_2d_a(j,i) 
     495                fr = myr*jj + total_2d_a(j,i+1) 
    531496                DO  ii = 0, dnx-1
    532497                   total_2d_o(j*dny+jj,i*dnx+ii) = ( fr - fl ) / dnx * ii + fl
    … …  
    536501       ENDDO
    537502!
    538 !--    cyclic boundary conditions for ocean grid
     503!--    Cyclic boundary conditions for ocean grid
    539504       total_2d_o(-nbgp:-1,:) = total_2d_o(ny_o+1-nbgp:ny_o,:)
    540505       total_2d_o(:,-nbgp:-1) = total_2d_o(:,nx_o+1-nbgp:nx_o)
    … …  
    542507       total_2d_o(ny_o+1:ny_o+nbgp,:) = total_2d_o(0:nbgp-1,:)
    543508       total_2d_o(:,nx_o+1:nx_o+nbgp) = total_2d_o(:,0:nbgp-1)
    544        
    545509
    546510       CALL MPI_SEND( total_2d_o(-nbgp,-nbgp), ngp_o, MPI_REAL, &
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |