[102] | 1 | SUBROUTINE surface_coupler |
---|
| 2 | |
---|
| 3 | !------------------------------------------------------------------------------! |
---|
| 4 | ! Actual revisions: |
---|
| 5 | ! ----------------- |
---|
[108] | 6 | ! include latent heatflux and salinity flux for atmosphere runs with moisture |
---|
| 7 | ! modifications to terminate coupled runs |
---|
[102] | 8 | ! |
---|
| 9 | ! |
---|
| 10 | ! Former revisions: |
---|
| 11 | ! ------------------ |
---|
| 12 | ! $Id: surface_coupler.f90 109 2007-08-28 15:26:47Z letzel $ |
---|
| 13 | ! |
---|
| 14 | ! Initial revision |
---|
| 15 | ! |
---|
| 16 | ! Description: |
---|
| 17 | ! ------------ |
---|
| 18 | ! Data exchange at the interface between coupled models |
---|
| 19 | !------------------------------------------------------------------------------! |
---|
| 20 | |
---|
| 21 | USE arrays_3d |
---|
| 22 | USE control_parameters |
---|
| 23 | USE cpulog |
---|
| 24 | USE grid_variables |
---|
| 25 | USE indices |
---|
| 26 | USE interfaces |
---|
| 27 | USE pegrid |
---|
| 28 | |
---|
| 29 | IMPLICIT NONE |
---|
| 30 | |
---|
[108] | 31 | INTEGER :: i, j, k |
---|
[102] | 32 | |
---|
| 33 | REAL :: simulated_time_remote |
---|
| 34 | |
---|
| 35 | #if defined( __parallel ) && defined( __mpi2 ) |
---|
| 36 | |
---|
| 37 | CALL cpu_log( log_point(39), 'surface_coupler', 'start' ) |
---|
| 38 | |
---|
| 39 | ! |
---|
[108] | 40 | !-- In case of model termination initiated by the remote model |
---|
| 41 | !-- (terminate_coupled_remote > 0), initiate termination of the local model. |
---|
| 42 | !-- The rest of the coupler must then be skipped because it would cause an MPI |
---|
| 43 | !-- intercomminucation hang. |
---|
| 44 | !-- If necessary, the coupler will be called at the beginning of the next |
---|
| 45 | !-- restart run. |
---|
| 46 | CALL MPI_SENDRECV( terminate_coupled, 1, MPI_INTEGER, myid, 0, & |
---|
| 47 | terminate_coupled_remote, 1, MPI_INTEGER, myid, 0, & |
---|
| 48 | comm_inter, status, ierr ) |
---|
| 49 | IF ( terminate_coupled_remote > 0 ) THEN |
---|
| 50 | IF ( myid == 0 ) THEN |
---|
| 51 | PRINT*, '+++ surface_coupler:' |
---|
| 52 | PRINT*, ' remote model "', TRIM( coupling_mode_remote ), & |
---|
| 53 | '" terminated' |
---|
| 54 | PRINT*, ' with terminate_coupled_remote = ', & |
---|
| 55 | terminate_coupled_remote |
---|
| 56 | PRINT*, ' local model "', TRIM( coupling_mode ), & |
---|
| 57 | '" has' |
---|
| 58 | PRINT*, ' terminate_coupled = ', & |
---|
| 59 | terminate_coupled |
---|
| 60 | ENDIF |
---|
| 61 | CALL local_stop |
---|
| 62 | RETURN |
---|
| 63 | ENDIF |
---|
| 64 | ! |
---|
| 65 | !-- Exchange the current simulated time between the models, |
---|
[102] | 66 | !-- currently just for testing |
---|
| 67 | CALL MPI_SEND( simulated_time, 1, MPI_REAL, myid, 11, comm_inter, ierr ) |
---|
| 68 | CALL MPI_RECV( simulated_time_remote, 1, MPI_REAL, myid, 11, & |
---|
| 69 | comm_inter, status, ierr ) |
---|
| 70 | WRITE ( 9, * ) simulated_time, ' remote: ', simulated_time_remote |
---|
| 71 | CALL local_flush( 9 ) |
---|
| 72 | |
---|
| 73 | ! |
---|
| 74 | !-- Exchange the interface data |
---|
| 75 | IF ( coupling_mode == 'atmosphere_to_ocean' ) THEN |
---|
| 76 | |
---|
| 77 | ! |
---|
| 78 | !-- Send heat flux at bottom surface to the ocean model |
---|
| 79 | WRITE ( 9, * ) '*** send shf to ocean' |
---|
| 80 | CALL local_flush( 9 ) |
---|
| 81 | CALL MPI_SEND( shf(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, & |
---|
| 82 | comm_inter, ierr ) |
---|
| 83 | WRITE ( 9, * ) ' ready' |
---|
| 84 | CALL local_flush( 9 ) |
---|
| 85 | |
---|
| 86 | ! |
---|
[108] | 87 | !-- Send humidity flux at bottom surface to the ocean model |
---|
| 88 | IF ( humidity ) THEN |
---|
| 89 | WRITE ( 9, * ) '*** send qsws to ocean' |
---|
| 90 | CALL local_flush( 9 ) |
---|
| 91 | CALL MPI_SEND( qsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 13, & |
---|
| 92 | comm_inter, ierr ) |
---|
| 93 | WRITE ( 9, * ) ' ready' |
---|
| 94 | CALL local_flush( 9 ) |
---|
| 95 | ENDIF |
---|
| 96 | |
---|
| 97 | ! |
---|
[102] | 98 | !-- Receive temperature at the bottom surface from the ocean model |
---|
| 99 | WRITE ( 9, * ) '*** receive pt from ocean' |
---|
| 100 | CALL local_flush( 9 ) |
---|
[108] | 101 | CALL MPI_RECV( pt(0,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, & |
---|
[102] | 102 | status, ierr ) |
---|
| 103 | WRITE ( 9, * ) ' ready' |
---|
| 104 | CALL local_flush( 9 ) |
---|
| 105 | |
---|
| 106 | ! |
---|
| 107 | !-- Send the momentum flux (u) at bottom surface to the ocean model |
---|
| 108 | WRITE ( 9, * ) '*** send usws to ocean' |
---|
| 109 | CALL local_flush( 9 ) |
---|
[108] | 110 | CALL MPI_SEND( usws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, & |
---|
[102] | 111 | comm_inter, ierr ) |
---|
| 112 | WRITE ( 9, * ) ' ready' |
---|
| 113 | CALL local_flush( 9 ) |
---|
| 114 | |
---|
| 115 | ! |
---|
| 116 | !-- Send the momentum flux (v) at bottom surface to the ocean model |
---|
| 117 | WRITE ( 9, * ) '*** send vsws to ocean' |
---|
| 118 | CALL local_flush( 9 ) |
---|
[108] | 119 | CALL MPI_SEND( vsws(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, & |
---|
[102] | 120 | comm_inter, ierr ) |
---|
| 121 | WRITE ( 9, * ) ' ready' |
---|
| 122 | CALL local_flush( 9 ) |
---|
| 123 | |
---|
| 124 | ELSEIF ( coupling_mode == 'ocean_to_atmosphere' ) THEN |
---|
| 125 | |
---|
| 126 | ! |
---|
| 127 | !-- Receive heat flux at the sea surface (top) from the atmosphere model |
---|
| 128 | WRITE ( 9, * ) '*** receive tswst from atmosphere' |
---|
| 129 | CALL local_flush( 9 ) |
---|
| 130 | CALL MPI_RECV( tswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 12, & |
---|
| 131 | comm_inter, status, ierr ) |
---|
| 132 | WRITE ( 9, * ) ' ready' |
---|
| 133 | CALL local_flush( 9 ) |
---|
| 134 | |
---|
| 135 | ! |
---|
[108] | 136 | !-- Receive humidity flux from the atmosphere model (bottom) |
---|
| 137 | !-- and add it to the heat flux at the sea surface (top)... |
---|
| 138 | IF ( humidity_remote ) THEN |
---|
| 139 | WRITE ( 9, * ) '*** receive qswst_remote from atmosphere' |
---|
| 140 | CALL local_flush( 9 ) |
---|
| 141 | CALL MPI_RECV( qswst_remote(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, & |
---|
| 142 | 13, comm_inter, status, ierr ) |
---|
| 143 | WRITE ( 9, * ) ' ready' |
---|
| 144 | CALL local_flush( 9 ) |
---|
| 145 | |
---|
[109] | 146 | !here tswst is still the sum of atmospheric bottom heat fluxes |
---|
| 147 | tswst = tswst + qswst_remote * 2.2626108e6 / 1005.0 |
---|
| 148 | !*latent heat of vaporization in m2/s2, or 540 cal/g, or 40.65 kJ/mol |
---|
| 149 | !/(rho_atm(=1.0)*c_p) |
---|
[108] | 150 | ! |
---|
| 151 | !-- ...and convert it to a salinity flux at the sea surface (top) |
---|
| 152 | !-- following Steinhorn (1991), JPO 21, pp. 1681-1683: |
---|
| 153 | !-- S'w' = -S * evaporation / ( rho_water * ( 1 - S ) ) |
---|
| 154 | saswst = -1.0 * sa(nzt,:,:) * qswst_remote / & |
---|
| 155 | ( rho(nzt,:,:) * ( 1.0 - sa(nzt,:,:) ) ) |
---|
| 156 | ENDIF |
---|
| 157 | |
---|
| 158 | ! |
---|
[102] | 159 | !-- Adjust the kinematic heat flux with respect to ocean density |
---|
| 160 | !-- (constants are the specific heat capacities for air and water) |
---|
[109] | 161 | !now tswst is the ocean top heat flux |
---|
[108] | 162 | tswst = tswst / rho(nzt,:,:) * 1005.0 / 4218.0 |
---|
[102] | 163 | |
---|
| 164 | ! |
---|
| 165 | !-- Send sea surface temperature to the atmosphere model |
---|
| 166 | WRITE ( 9, * ) '*** send pt to atmosphere' |
---|
| 167 | CALL local_flush( 9 ) |
---|
[108] | 168 | CALL MPI_SEND( pt(nzt,nys-1,nxl-1), 1, type_xy, myid, 14, comm_inter, & |
---|
[102] | 169 | ierr ) |
---|
| 170 | WRITE ( 9, * ) ' ready' |
---|
| 171 | CALL local_flush( 9 ) |
---|
| 172 | |
---|
| 173 | ! |
---|
| 174 | !-- Receive momentum flux (u) at the sea surface (top) from the atmosphere |
---|
| 175 | !-- model |
---|
| 176 | WRITE ( 9, * ) '*** receive uswst from atmosphere' |
---|
| 177 | CALL local_flush( 9 ) |
---|
[108] | 178 | CALL MPI_RECV( uswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 15, & |
---|
[102] | 179 | comm_inter, status, ierr ) |
---|
| 180 | WRITE ( 9, * ) ' ready' |
---|
| 181 | CALL local_flush( 9 ) |
---|
| 182 | |
---|
| 183 | ! |
---|
| 184 | !-- Receive momentum flux (v) at the sea surface (top) from the atmosphere |
---|
| 185 | !-- model |
---|
| 186 | WRITE ( 9, * ) '*** receive vswst from atmosphere' |
---|
| 187 | CALL local_flush( 9 ) |
---|
[108] | 188 | CALL MPI_RECV( vswst(nys-1,nxl-1), ngp_xy, MPI_REAL, myid, 16, & |
---|
[102] | 189 | comm_inter, status, ierr ) |
---|
| 190 | WRITE ( 9, * ) ' ready' |
---|
| 191 | CALL local_flush( 9 ) |
---|
| 192 | |
---|
| 193 | ! |
---|
| 194 | !-- Adjust the momentum fluxes with respect to ocean density |
---|
[108] | 195 | uswst = uswst / rho(nzt,:,:) |
---|
| 196 | vswst = vswst / rho(nzt,:,:) |
---|
[102] | 197 | |
---|
| 198 | ENDIF |
---|
| 199 | |
---|
| 200 | CALL cpu_log( log_point(39), 'surface_coupler', 'stop' ) |
---|
| 201 | |
---|
| 202 | #endif |
---|
| 203 | |
---|
| 204 | END SUBROUTINE surface_coupler |
---|