Newer
Older
IF( nn_components == jp_iam_oce ) THEN
zotx1(:,:) = uu(:,:,1,Kmm)
zoty1(:,:) = vv(:,:,1,Kmm)
ELSE
SELECT CASE( TRIM( sn_snd_crt%cldes ) )
CASE( 'oce only' ) ! C-grid ==> T
IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) )
zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji ,jj-1,1,Kmm) )
END_2D
ELSE
! Temporarily Changed for UKV
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = uu(ji,jj,1,Kmm)
zoty1(ji,jj) = vv(ji,jj,1,Kmm)
END_2D
ENDIF
CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
END SELECT
CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
!
ENDIF
!
!
IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
! ! Ocean component
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
zotx1(:,:) = ztmp1(:,:) ! overwrite the components
zoty1(:,:) = ztmp2(:,:)
IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
zitx1(:,:) = ztmp1(:,:) ! overwrite the components
zity1(:,:) = ztmp2(:,:)
ENDIF
ELSE
! Temporary code for HadGEM3 - will be removed eventually.
! Only applies when we want uvel on U grid and vvel on V grid
! Rotate U and V onto geographic grid before sending.
DO_2D( 0, 0, 0, 0 )
ztmp1(ji,jj)=0.25*vmask(ji,jj,1) &
*(zotx1(ji,jj)+zotx1(ji-1,jj) &
+zotx1(ji,jj+1)+zotx1(ji-1,jj+1))
ztmp2(ji,jj)=0.25*umask(ji,jj,1) &
*(zoty1(ji,jj)+zoty1(ji+1,jj) &
+zoty1(ji,jj-1)+zoty1(ji+1,jj-1))
END_2D
! zotx1 and zoty1 are input only to repcmo while ztmp5 and ztmp6
! are the newly calculated (output) values.
! Don't make the mistake of using zotx1 and zoty1 twice in this
! call for both input and output fields since it creates INTENT
! conflicts.
CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,ztmp5,ztmp6,ikchoix)
zotx1(:,:)=ztmp5(:,:)
zoty1(:,:)=ztmp6(:,:)
! Ensure any N fold and wrap columns are updated.
CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocx1)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocy1)%clgrid, -1.0_wp )
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
ENDIF
ENDIF
!
! spherical coordinates to cartesian -> 2 components to 3 components
IF( TRIM( sn_snd_crt%clvref ) == 'cartesian' ) THEN
ztmp1(:,:) = zotx1(:,:) ! ocean currents
ztmp2(:,:) = zoty1(:,:)
CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
!
IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
ztmp1(:,:) = zitx1(:,:)
ztmp1(:,:) = zity1(:,:)
CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
ENDIF
ENDIF
!
IF( ssnd(jps_ocx1)%laction ) CALL cpl_snd( jps_ocx1, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
IF( ssnd(jps_ocy1)%laction ) CALL cpl_snd( jps_ocy1, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
IF( ssnd(jps_ocz1)%laction ) CALL cpl_snd( jps_ocz1, isec, RESHAPE ( zotz1, (/jpi,jpj,1/) ), info ) ! ocean z current 1st grid
!
IF( ssnd(jps_ivx1)%laction ) CALL cpl_snd( jps_ivx1, isec, RESHAPE ( zitx1, (/jpi,jpj,1/) ), info ) ! ice x current 1st grid
IF( ssnd(jps_ivy1)%laction ) CALL cpl_snd( jps_ivy1, isec, RESHAPE ( zity1, (/jpi,jpj,1/) ), info ) ! ice y current 1st grid
IF( ssnd(jps_ivz1)%laction ) CALL cpl_snd( jps_ivz1, isec, RESHAPE ( zitz1, (/jpi,jpj,1/) ), info ) ! ice z current 1st grid
!
ENDIF
!
! ! ------------------------- !
! ! Surface current to waves !
! ! ------------------------- !
IF( ssnd(jps_ocxw)%laction .OR. ssnd(jps_ocyw)%laction ) THEN
!
! j+1 j -----V---F
! surface velocity always sent from T point ! |
! j | T U
! | |
! j j-1 -I-------|
! (for I) | |
! i-1 i i
! i i+1 (for I)
SELECT CASE( TRIM( sn_snd_crtw%cldes ) )
CASE( 'oce only' ) ! C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu(ji,jj,1,Kmm) + uu(ji-1,jj ,1,Kmm) )
zoty1(ji,jj) = 0.5 * ( vv(ji,jj,1,Kmm) + vv(ji , jj-1,1,Kmm) )
END_2D
CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj)
zitx1(ji,jj) = 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zity1(ji,jj) = 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
CALL lbc_lnk( 'sbccpl', zitx1, 'T', -1.0_wp, zity1, 'T', -1.0_wp )
CASE( 'mixed oce-ice' ) ! Ocean and Ice on C-grid ==> T
DO_2D( 0, 0, 0, 0 )
zotx1(ji,jj) = 0.5 * ( uu (ji,jj,1,Kmm) + uu (ji-1,jj ,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( u_ice(ji,jj ) + u_ice(ji-1,jj ) ) * fr_i(ji,jj)
zoty1(ji,jj) = 0.5 * ( vv (ji,jj,1,Kmm) + vv (ji ,jj-1,1,Kmm) ) * zfr_l(ji,jj) &
& + 0.5 * ( v_ice(ji,jj ) + v_ice(ji ,jj-1 ) ) * fr_i(ji,jj)
END_2D
END SELECT
CALL lbc_lnk( 'sbccpl', zotx1, ssnd(jps_ocxw)%clgrid, -1.0_wp, zoty1, ssnd(jps_ocyw)%clgrid, -1.0_wp )
!
!
IF( TRIM( sn_snd_crtw%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components
! ! Ocean component
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->e', ztmp1 ) ! 1st component
CALL rot_rep( zotx1, zoty1, ssnd(jps_ocxw)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
zotx1(:,:) = ztmp1(:,:) ! overwrite the components
zoty1(:,:) = ztmp2(:,:)
IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component
CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component
CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component
zitx1(:,:) = ztmp1(:,:) ! overwrite the components
zity1(:,:) = ztmp2(:,:)
ENDIF
ENDIF
!
! ! spherical coordinates to cartesian -> 2 components to 3 components
! IF( TRIM( sn_snd_crtw%clvref ) == 'cartesian' ) THEN
! ztmp1(:,:) = zotx1(:,:) ! ocean currents
! ztmp2(:,:) = zoty1(:,:)
! CALL oce2geo ( ztmp1, ztmp2, 'T', zotx1, zoty1, zotz1 )
! !
! IF( ssnd(jps_ivx1)%laction ) THEN ! ice velocities
! ztmp1(:,:) = zitx1(:,:)
! ztmp1(:,:) = zity1(:,:)
! CALL oce2geo ( ztmp1, ztmp2, 'T', zitx1, zity1, zitz1 )
! ENDIF
! ENDIF
!
IF( ssnd(jps_ocxw)%laction ) CALL cpl_snd( jps_ocxw, isec, RESHAPE ( zotx1, (/jpi,jpj,1/) ), info ) ! ocean x current 1st grid
IF( ssnd(jps_ocyw)%laction ) CALL cpl_snd( jps_ocyw, isec, RESHAPE ( zoty1, (/jpi,jpj,1/) ), info ) ! ocean y current 1st grid
!
ENDIF
!
IF( ssnd(jps_ficet)%laction ) THEN
CALL cpl_snd( jps_ficet, isec, RESHAPE ( fr_i, (/jpi,jpj,1/) ), info )
ENDIF
! ! ------------------------- !
! ! Water levels to waves !
! ! ------------------------- !
IF( ssnd(jps_wlev)%laction ) THEN
IF( ln_apr_dyn ) THEN
IF( kt /= nit000 ) THEN
ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
ELSE
ztmp1(:,:) = ssh(:,:,Kbb)
ENDIF
ELSE
ztmp1(:,:) = ssh(:,:,Kmm)
ENDIF
CALL cpl_snd( jps_wlev , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )
ENDIF
!
! Fields sent by OCE to SAS when doing OCE<->SAS coupling
! ! SSH
IF( ssnd(jps_ssh )%laction ) THEN
! ! removed inverse barometer ssh when Patm
! forcing is used (for sea-ice dynamics)
IF( ln_apr_dyn ) THEN ; ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )
ELSE ; ztmp1(:,:) = ssh(:,:,Kmm)
ENDIF
CALL cpl_snd( jps_ssh , isec, RESHAPE ( ztmp1 , (/jpi,jpj,1/) ), info )
ENDIF
! ! SSS
IF( ssnd(jps_soce )%laction ) THEN
sparonuz
committed
CALL cpl_snd( jps_soce , isec, CASTSP(RESHAPE ( ts(:,:,1,jp_sal,Kmm), (/jpi,jpj,1/) )), info )
ENDIF
! ! first T level thickness
IF( ssnd(jps_e3t1st )%laction ) THEN
sparonuz
committed
CALL cpl_snd( jps_e3t1st, isec, CASTSP(RESHAPE ( e3t(:,:,1,Kmm) , (/jpi,jpj,1/) )), info )
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
ENDIF
! ! Qsr fraction
IF( ssnd(jps_fraqsr)%laction ) THEN
CALL cpl_snd( jps_fraqsr, isec, RESHAPE ( fraqsr_1lev(:,:) , (/jpi,jpj,1/) ), info )
ENDIF
!
! Fields sent by SAS to OCE when OASIS coupling
! ! Solar heat flux
IF( ssnd(jps_qsroce)%laction ) CALL cpl_snd( jps_qsroce, isec, RESHAPE ( qsr , (/jpi,jpj,1/) ), info )
IF( ssnd(jps_qnsoce)%laction ) CALL cpl_snd( jps_qnsoce, isec, RESHAPE ( qns , (/jpi,jpj,1/) ), info )
IF( ssnd(jps_oemp )%laction ) CALL cpl_snd( jps_oemp , isec, RESHAPE ( emp , (/jpi,jpj,1/) ), info )
IF( ssnd(jps_sflx )%laction ) CALL cpl_snd( jps_sflx , isec, RESHAPE ( sfx , (/jpi,jpj,1/) ), info )
IF( ssnd(jps_otx1 )%laction ) CALL cpl_snd( jps_otx1 , isec, RESHAPE ( utau, (/jpi,jpj,1/) ), info )
IF( ssnd(jps_oty1 )%laction ) CALL cpl_snd( jps_oty1 , isec, RESHAPE ( vtau, (/jpi,jpj,1/) ), info )
IF( ssnd(jps_rnf )%laction ) CALL cpl_snd( jps_rnf , isec, RESHAPE ( rnf , (/jpi,jpj,1/) ), info )
IF( ssnd(jps_taum )%laction ) CALL cpl_snd( jps_taum , isec, RESHAPE ( taum, (/jpi,jpj,1/) ), info )
#if defined key_si3
! ! ------------------------- !
! ! Sea surface freezing temp !
! ! ------------------------- !
! needed by Met Office
CALL eos_fzp(ts(:,:,1,jp_sal,Kmm), sstfrz)
ztmp1(:,:) = sstfrz(:,:) + rt0
IF( ssnd(jps_sstfrz)%laction ) CALL cpl_snd( jps_sstfrz, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info)
#endif
!
IF (ln_timing) CALL timing_stop('sbc_cpl_snd')
END SUBROUTINE sbc_cpl_snd
!!======================================================================
END MODULE sbccpl