Changeset 3340 for branches/2012
- Timestamp:
- 2012-04-02T13:05:35+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3294 r3340 32 32 USE sbc_oce ! Surface boundary condition: ocean fields 33 33 USE sbc_ice ! Surface boundary condition: ice fields 34 USE icb_oce ! Icebergs 35 USE icbdia ! Iceberg budgets 34 36 USE sbcssr ! restoring term toward SST/SSS climatology 35 37 USE phycst ! physical constants … … 59 61 60 62 INTEGER :: nid_T, nz_T, nh_T, ndim_T, ndim_hT ! grid_T file 63 INTEGER :: nb_T , ndim_bT ! grid_T file 61 64 INTEGER :: nid_U, nz_U, nh_U, ndim_U, ndim_hU ! grid_U file 62 65 INTEGER :: nid_V, nz_V, nh_V, ndim_V, ndim_hV ! grid_V file … … 65 68 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_hT, ndex_hU, ndex_hV 66 69 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_T, ndex_U, ndex_V 70 INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndex_bT 67 71 68 72 !! * Substitutions … … 234 238 INTEGER :: ierr ! error code return from allocation 235 239 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 240 INTEGER :: jn, ierror ! local integers 236 241 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 237 242 !! … … 320 325 CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndex_T , ndim_T ) ! volume 321 326 CALL wheneq( jpi*jpj , tmask, 1, 1., ndex_hT, ndim_hT ) ! surface 327 ! 328 IF( ln_icebergs ) THEN 329 ! 330 !! allocation cant go in dia_wri_alloc because ln_icebergs is only set after 331 !! that routine is called from nemogcm, so do it here immediately before its needed 332 ALLOCATE( ndex_bT(jpi*jpj*nclasses), STAT=ierror ) 333 IF( lk_mpp ) CALL mpp_sum( ierror ) 334 IF( ierror /= 0 ) THEN 335 CALL ctl_stop('dia_wri: failed to allocate iceberg diagnostic array') 336 RETURN 337 ENDIF 338 ! 339 !! iceberg vertical coordinate is class number 340 CALL histvert( nid_T, "class", "Iceberg class", & ! Vertical grid: class 341 & "number", nclasses, class_num, nb_T ) 342 ! 343 !! each class just needs the surface index pattern 344 ndim_bT = 3 345 DO jn = 1,nclasses 346 ndex_bT((jn-1)*jpi*jpj+1:jn*jpi*jpj) = ndex_hT(1:jpi*jpj) 347 ENDDO 348 ! 349 ENDIF 322 350 323 351 ! Define the U grid FILE ( nid_U ) … … 401 429 CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm 402 430 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 431 ! 432 IF( ln_icebergs ) THEN 433 CALL histdef( nid_T, "calving" , "calving mass input" , "kg/s" , & 434 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 435 CALL histdef( nid_T, "calving_heat" , "calving heat flux" , "XXXX" , & 436 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 437 CALL histdef( nid_T, "berg_floating_melt" , "Melt rate of icebergs + bits" , "kg/m2/s", & 438 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 439 CALL histdef( nid_T, "berg_stored_ice" , "Accumulated ice mass by class" , "kg" , & 440 & jpi, jpj, nh_T, nclasses , 1, nclasses , nb_T , 32, clop, zsto, zout ) 441 IF( ln_bergdia ) THEN 442 CALL histdef( nid_T, "berg_melt" , "Melt rate of icebergs" , "kg/m2/s", & 443 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 444 CALL histdef( nid_T, "berg_melt_buoy" , "Buoyancy component of iceberg melt rate" , "kg/m2/s", & 445 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 446 CALL histdef( nid_T, "berg_melt_eros" , "Erosion component of iceberg melt rate" , "kg/m2/s", & 447 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 448 CALL histdef( nid_T, "berg_melt_conv" , "Convective component of iceberg melt rate", "kg/m2/s", & 449 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 450 CALL histdef( nid_T, "berg_virtual_area" , "Virtual coverage by icebergs" , "m2" , & 451 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 452 CALL histdef( nid_T, "bits_src" , "Mass source of bergy bits" , "kg/m2/s", & 453 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 454 CALL histdef( nid_T, "bits_melt" , "Melt rate of bergy bits" , "kg/m2/s", & 455 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 456 CALL histdef( nid_T, "bits_mass" , "Bergy bit density field" , "kg/m2" , & 457 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 458 CALL histdef( nid_T, "berg_mass" , "Iceberg density field" , "kg/m2" , & 459 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 460 CALL histdef( nid_T, "berg_real_calving" , "Calving into iceberg class" , "kg/s" , & 461 & jpi, jpj, nh_T, nclasses , 1, nclasses , nb_T , 32, clop, zsto, zout ) 462 ENDIF 463 ENDIF 464 403 465 #if ! defined key_coupled 404 466 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp … … 555 617 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 556 618 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 619 ! 620 IF( ln_icebergs ) THEN 621 ! 622 CALL histwrite( nid_T, "calving" , it, berg_grid%calving , ndim_hT, ndex_hT ) 623 CALL histwrite( nid_T, "calving_heat" , it, berg_grid%calving_hflx , ndim_hT, ndex_hT ) 624 CALL histwrite( nid_T, "berg_floating_melt" , it, berg_grid%floating_melt, ndim_hT, ndex_hT ) 625 ! 626 CALL histwrite( nid_T, "berg_stored_ice" , it, berg_grid%stored_ice , ndim_bT, ndex_bT ) 627 ! 628 IF( ln_bergdia ) THEN 629 CALL histwrite( nid_T, "berg_melt" , it, berg_melt , ndim_hT, ndex_hT ) 630 CALL histwrite( nid_T, "berg_melt_buoy" , it, melt_buoy , ndim_hT, ndex_hT ) 631 CALL histwrite( nid_T, "berg_melt_eros" , it, melt_eros , ndim_hT, ndex_hT ) 632 CALL histwrite( nid_T, "berg_melt_conv" , it, melt_conv , ndim_hT, ndex_hT ) 633 CALL histwrite( nid_T, "berg_virtual_area" , it, virtual_area , ndim_hT, ndex_hT ) 634 CALL histwrite( nid_T, "bits_src" , it, bits_src , ndim_hT, ndex_hT ) 635 CALL histwrite( nid_T, "bits_melt" , it, bits_melt , ndim_hT, ndex_hT ) 636 CALL histwrite( nid_T, "bits_mass" , it, bits_mass , ndim_hT, ndex_hT ) 637 CALL histwrite( nid_T, "berg_mass" , it, berg_mass , ndim_hT, ndex_hT ) 638 ! 639 CALL histwrite( nid_T, "berg_real_calving" , it, real_calving , ndim_bT, ndex_bT ) 640 ENDIF 641 ENDIF 642 557 643 #if ! defined key_coupled 558 644 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r3294 r3340 256 256 END DO 257 257 ! applied the lateral boundary conditions 258 IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 ) CALL lbc_lnk_e( gcb, c_solver_pt, 1. )258 IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 ) CALL lbc_lnk_e( gcb, c_solver_pt, 1., jpr2di, jpr2dj ) 259 259 260 260 #if defined key_agrif -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r2442 r3340 55 55 56 56 INTERFACE lbc_lnk_e 57 MODULE PROCEDURE lbc_lnk_2d 57 MODULE PROCEDURE lbc_lnk_2d_e 58 58 END INTERFACE 59 59 … … 270 270 END SUBROUTINE lbc_lnk_2d 271 271 272 SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 273 !!--------------------------------------------------------------------- 274 !! *** ROUTINE lbc_lnk_2d *** 275 !! 276 !! ** Purpose : set lateral boundary conditions on a 2D array (non mpp case) 277 !! special dummy routine to allow for use of halo indexing in mpp case 278 !! 279 !! ** Method : psign = -1 : change the sign across the north fold 280 !! = 1 : no change of the sign across the north fold 281 !! = 0 : no change of the sign across the north fold and 282 !! strict positivity preserved: use inner row/column 283 !! for closed boundaries. 284 !!---------------------------------------------------------------------- 285 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 286 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 2D array on which the lbc is applied 287 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 288 INTEGER , INTENT(in ) :: jpri ! size of extra halo (not needed in non-mpp) 289 INTEGER , INTENT(in ) :: jprj ! size of extra halo (not needed in non-mpp) 290 !!---------------------------------------------------------------------- 291 292 CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 293 ! 294 END SUBROUTINE lbc_lnk_2d_e 295 272 296 #endif 273 297 -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3294 r3340 67 67 PUBLIC mppobc, mpp_ini_ice, mpp_ini_znl 68 68 PUBLIC mppsize 69 PUBLIC mppsend, mpprecv ! needed by ICB routines 69 70 PUBLIC lib_mpp_alloc ! Called in nemogcm.F90 70 71 … … 143 144 144 145 ! Type of send : standard, buffered, immediate 145 CHARACTER(len=1) :: cn_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend)146 LOGICAL :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I')147 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend146 CHARACTER(len=1) :: cn_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 147 LOGICAL , PUBLIC :: l_isend = .FALSE. ! isend use indicator (T if cn_mpi_send='I') 148 INTEGER :: nn_buffer = 0 ! size of the buffer in case of mpi_bsend 148 149 149 150 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 159 160 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2ew, t2we ! 2d for east-west & west-east 160 161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: t2p1, t2p2 ! 2d for north fold 161 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ns, tr2sn ! 2d for north-south & south-north + extra outer halo162 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tr2ew, tr2we ! 2d for east-west & west-east + extra outer halo163 162 164 163 ! Arrays used in mpp_lbc_north_3d() … … 207 206 & t2ew(jpj,jpreci ,2) , t2we(jpj,jpreci ,2) , & 208 207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 209 !210 & tr2ns(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , &211 & tr2sn(1-jpr2di:jpi+jpr2di,jprecj+jpr2dj,2) , &212 & tr2ew(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , &213 & tr2we(1-jpr2dj:jpj+jpr2dj,jpreci+jpr2di,2) , &214 208 ! 215 209 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , & … … 947 941 948 942 949 SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn )943 SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 950 944 !!---------------------------------------------------------------------- 951 945 !! *** routine mpp_lnk_2d_e *** … … 958 952 !! nlci : first dimension of the local subdomain 959 953 !! nlcj : second dimension of the local subdomain 960 !! jpr 2di: number of rows for extra outer halo961 !! jpr 2dj: number of columns for extra outer halo954 !! jpri : number of rows for extra outer halo 955 !! jprj : number of columns for extra outer halo 962 956 !! nbondi : mark for "east-west local boundary" 963 957 !! nbondj : mark for "north-south local boundary" … … 968 962 !! 969 963 !!---------------------------------------------------------------------- 970 REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) :: pt2d ! 2D array with extra halo 971 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 972 ! ! = T , U , V , F , W and I points 973 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 974 !! ! north boundary, = 1. otherwise 964 INTEGER , INTENT(in ) :: jpri 965 INTEGER , INTENT(in ) :: jprj 966 REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) :: pt2d ! 2D array with extra halo 967 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of ptab array grid-points 968 ! ! = T , U , V , F , W and I points 969 REAL(wp) , INTENT(in ) :: psgn ! =-1 the sign change across the 970 !! ! north boundary, = 1. otherwise 975 971 INTEGER :: jl ! dummy loop indices 976 972 INTEGER :: imigr, iihom, ijhom ! temporary integers … … 978 974 INTEGER :: ml_req1, ml_req2, ml_err ! for key_mpi_isend 979 975 INTEGER, DIMENSION(MPI_STATUS_SIZE) :: ml_stat ! for key_mpi_isend 980 !!---------------------------------------------------------------------- 981 982 ipreci = jpreci + jpr2di ! take into account outer extra 2D overlap area 983 iprecj = jprecj + jpr2dj 976 !! 977 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 978 REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 979 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 980 REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 981 !!---------------------------------------------------------------------- 982 983 ipreci = jpreci + jpri ! take into account outer extra 2D overlap area 984 iprecj = jprecj + jprj 984 985 985 986 … … 989 990 ! 990 991 ! !* North-South boundaries (always colsed) 991 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jpr 2dj : jprecj ) = 0.e0 ! south except at F-point992 pt2d(:,nlcj-jprecj+1:jpj+jpr 2dj) = 0.e0 ! north992 IF( .NOT. cd_type == 'F' ) pt2d(:, 1-jprj : jprecj ) = 0.e0 ! south except at F-point 993 pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0.e0 ! north 993 994 994 995 ! ! East-West boundaries 995 996 ! !* Cyclic east-west 996 997 IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 997 pt2d(1-jpr 2di: 1 ,:) = pt2d(jpim1-jpr2di: jpim1 ,:) ! east998 pt2d( jpi :jpi+jpr 2di,:) = pt2d( 2 :2+jpr2di,:) ! west998 pt2d(1-jpri: 1 ,:) = pt2d(jpim1-jpri: jpim1 ,:) ! east 999 pt2d( jpi :jpi+jpri,:) = pt2d( 2 :2+jpri,:) ! west 999 1000 ! 1000 1001 ELSE !* closed 1001 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpr 2di :jpreci ,:) = 0.e0 ! south except at F-point1002 pt2d(nlci-jpreci+1:jpi+jpr 2di,:) = 0.e0 ! north1002 IF( .NOT. cd_type == 'F' ) pt2d( 1-jpri :jpreci ,:) = 0.e0 ! south except at F-point 1003 pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0 ! north 1003 1004 ENDIF 1004 1005 ! … … 1009 1010 ! 1010 1011 SELECT CASE ( jpni ) 1011 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jpr 2dj), cd_type, psgn, pr2dj=jpr2dj )1012 CASE ( 1 ) ; CALL lbc_nfd ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 1012 1013 CASE DEFAULT ; CALL mpp_lbc_north_e( pt2d , cd_type, psgn ) 1013 1014 END SELECT … … 1021 1022 SELECT CASE ( nbondi ) ! Read Dirichlet lateral conditions 1022 1023 CASE ( -1, 0, 1 ) ! all exept 2 (i.e. close case) 1023 iihom = nlci-nreci-jpr 2di1024 iihom = nlci-nreci-jpri 1024 1025 DO jl = 1, ipreci 1025 tr2ew(:,jl,1) = pt2d(jpreci+jl,:)1026 tr2we(:,jl,1) = pt2d(iihom +jl,:)1026 r2dew(:,jl,1) = pt2d(jpreci+jl,:) 1027 r2dwe(:,jl,1) = pt2d(iihom +jl,:) 1027 1028 END DO 1028 1029 END SELECT 1029 1030 ! 1030 1031 ! ! Migrations 1031 imigr = ipreci * ( jpj + 2*jpr 2dj)1032 imigr = ipreci * ( jpj + 2*jprj) 1032 1033 ! 1033 1034 SELECT CASE ( nbondi ) 1034 1035 CASE ( -1 ) 1035 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req1 )1036 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )1036 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 1037 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 1037 1038 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1038 1039 CASE ( 0 ) 1039 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )1040 CALL mppsend( 2, tr2we(1-jpr2dj,1,1), imigr, noea, ml_req2 )1041 CALL mpprecv( 1, tr2ew(1-jpr2dj,1,2), imigr, noea )1042 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )1040 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 1041 CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 1042 CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 1043 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 1043 1044 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1044 1045 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1045 1046 CASE ( 1 ) 1046 CALL mppsend( 1, tr2ew(1-jpr2dj,1,1), imigr, nowe, ml_req1 )1047 CALL mpprecv( 2, tr2we(1-jpr2dj,1,2), imigr, nowe )1047 CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 1048 CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 1048 1049 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1049 1050 END SELECT … … 1055 1056 CASE ( -1 ) 1056 1057 DO jl = 1, ipreci 1057 pt2d(iihom+jl,:) = tr2ew(:,jl,2)1058 pt2d(iihom+jl,:) = r2dew(:,jl,2) 1058 1059 END DO 1059 1060 CASE ( 0 ) 1060 1061 DO jl = 1, ipreci 1061 pt2d(jl-jpr 2di,:) = tr2we(:,jl,2)1062 pt2d( iihom+jl,:) = tr2ew(:,jl,2)1062 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 1063 pt2d( iihom+jl,:) = r2dew(:,jl,2) 1063 1064 END DO 1064 1065 CASE ( 1 ) 1065 1066 DO jl = 1, ipreci 1066 pt2d(jl-jpr 2di,:) = tr2we(:,jl,2)1067 pt2d(jl-jpri,:) = r2dwe(:,jl,2) 1067 1068 END DO 1068 1069 END SELECT … … 1074 1075 ! 1075 1076 IF( nbondj /= 2 ) THEN ! Read Dirichlet lateral conditions 1076 ijhom = nlcj-nrecj-jpr 2dj1077 ijhom = nlcj-nrecj-jprj 1077 1078 DO jl = 1, iprecj 1078 tr2sn(:,jl,1) = pt2d(:,ijhom +jl)1079 tr2ns(:,jl,1) = pt2d(:,jprecj+jl)1079 r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 1080 r2dns(:,jl,1) = pt2d(:,jprecj+jl) 1080 1081 END DO 1081 1082 ENDIF 1082 1083 ! 1083 1084 ! ! Migrations 1084 imigr = iprecj * ( jpi + 2*jpr 2di )1085 imigr = iprecj * ( jpi + 2*jpri ) 1085 1086 ! 1086 1087 SELECT CASE ( nbondj ) 1087 1088 CASE ( -1 ) 1088 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req1 )1089 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )1089 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 1090 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 1090 1091 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1091 1092 CASE ( 0 ) 1092 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )1093 CALL mppsend( 4, tr2sn(1-jpr2di,1,1), imigr, nono, ml_req2 )1094 CALL mpprecv( 3, tr2ns(1-jpr2di,1,2), imigr, nono )1095 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )1093 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 1094 CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 1095 CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 1096 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 1096 1097 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1097 1098 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1098 1099 CASE ( 1 ) 1099 CALL mppsend( 3, tr2ns(1-jpr2di,1,1), imigr, noso, ml_req1 )1100 CALL mpprecv( 4, tr2sn(1-jpr2di,1,2), imigr, noso )1100 CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 1101 CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 1101 1102 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1102 1103 END SELECT … … 1108 1109 CASE ( -1 ) 1109 1110 DO jl = 1, iprecj 1110 pt2d(:,ijhom+jl) = tr2ns(:,jl,2)1111 pt2d(:,ijhom+jl) = r2dns(:,jl,2) 1111 1112 END DO 1112 1113 CASE ( 0 ) 1113 1114 DO jl = 1, iprecj 1114 pt2d(:,jl-jpr 2dj) = tr2sn(:,jl,2)1115 pt2d(:,ijhom+jl ) = tr2ns(:,jl,2)1115 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 1116 pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 1116 1117 END DO 1117 1118 CASE ( 1 ) 1118 1119 DO jl = 1, iprecj 1119 pt2d(:,jl-jpr 2dj) = tr2sn(:,jl,2)1120 pt2d(:,jl-jprj) = r2dsn(:,jl,2) 1120 1121 END DO 1121 1122 END SELECT -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r3294 r3340 39 39 LOGICAL , PUBLIC :: ln_ssr = .FALSE. !: Sea Surface restoring on SST and/or SSS 40 40 LOGICAL , PUBLIC :: ln_apr_dyn = .FALSE. !: Atmospheric pressure forcing used on dynamics (ocean & ice) 41 LOGICAL , PUBLIC :: ln_icebergs = .FALSE. !: Icebergs 41 42 INTEGER , PUBLIC :: nn_ice = 0 !: flag on ice in the surface boundary condition (=0/1/2/3) 42 43 INTEGER , PUBLIC :: nn_fwb = 0 !: FreshWater Budget: -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3294 r3340 43 43 USE bdy_par ! for lk_bdy 44 44 USE bdyice_lim2 ! unstructured open boundary data (bdy_ice_lim_2 routine) 45 USE icbrun ! Icebergs! 45 46 46 47 USE prtctl ! Print control (prt_ctl routine) … … 282 283 CASE( 4 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model 283 284 END SELECT 285 286 IF( ln_icebergs ) CALL icb_stp( kt ) ! compute icebergs 284 287 285 288 IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r3294 r3340 284 284 285 285 IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0) THEN 286 CALL lbc_lnk_e( gcp (:,:,1), c_solver_pt, 1. ) ! lateral boundary conditions287 CALL lbc_lnk_e( gcp (:,:,2), c_solver_pt, 1. ) ! lateral boundary conditions288 CALL lbc_lnk_e( gcp (:,:,3), c_solver_pt, 1. ) ! lateral boundary conditions289 CALL lbc_lnk_e( gcp (:,:,4), c_solver_pt, 1. ) ! lateral boundary conditions290 CALL lbc_lnk_e( gcdprc(:,:) , c_solver_pt, 1. ) ! lateral boundary conditions291 CALL lbc_lnk_e( gcdmat(:,:) , c_solver_pt, 1. ) ! lateral boundary conditions286 CALL lbc_lnk_e( gcp (:,:,1), c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 287 CALL lbc_lnk_e( gcp (:,:,2), c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 288 CALL lbc_lnk_e( gcp (:,:,3), c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 289 CALL lbc_lnk_e( gcp (:,:,4), c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 290 CALL lbc_lnk_e( gcdprc(:,:) , c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 291 CALL lbc_lnk_e( gcdmat(:,:) , c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 292 292 IF( npolj /= 0 ) CALL sol_exd( gcp , c_solver_pt ) ! switch northernelements 293 293 END IF -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/SOL/solsor.F90
r3294 r3340 81 81 ! ! ============== 82 82 83 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! lateral boundary conditions83 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 84 84 85 85 ! Residus … … 104 104 icount = icount + 1 105 105 106 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! lateral boundary conditions106 IF( MOD(icount,ijpr2d+1) == 0 ) CALL lbc_lnk_e( gcx, c_solver_pt, 1., jpr2di, jpr2dj ) ! lateral boundary conditions 107 107 108 108 ! Guess red update … … 167 167 ! Output in gcx 168 168 ! ------------- 169 CALL lbc_lnk_e( gcx, c_solver_pt, 1. ) ! boundary conditions169 CALL lbc_lnk_e( gcx, c_solver_pt, 1._wp, jpr2di, jpr2dj ) ! boundary conditions 170 170 ! 171 171 CALL wrk_dealloc( jpi, jpj, ztab ) -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3294 r3340 61 61 USE diaobs ! Observation diagnostics (dia_obs_init routine) 62 62 USE step ! NEMO time-stepping (stp routine) 63 USE icbini ! handle bergs, initialisation 64 USE icbrun ! handle bergs, calving, themodynamics and transport 63 65 #if defined key_oasis3 64 66 USE cpl_oasis3 ! OASIS3 coupling … … 162 164 163 165 IF( lk_diaobs ) CALL dia_obs_wri 166 IF( ln_icebergs ) CALL icb_end( nitend ) 164 167 165 168 ! !------------------------! … … 360 363 ! ! Misc. options 361 364 IF( nn_cla == 1 ) CALL cla_init ! Cross Land Advection 365 CALL icb_init( rdt, nit000) ! initialise icebergs instance 362 366 363 367 #if defined key_top
Note: See TracChangeset
for help on using the changeset viewer.