Changeset 10679 for NEMO/branches/2019/fix_ticket2238_solution2/src/OCE/ICB/icblbc.F90

Timestamp:

2019-02-14T14:11:43+01:00 (5 years ago)

Author:

mathiot

Message:

branch for solution 2 of ticket #2238

Location:

NEMO/branches/2019/fix_ticket2238_solution2

Files:

• . (copied) (copied from NEMO/trunk)
• src/OCE/ICB/icblbc.F90 (modified) (14 diffs)

NEMO/branches/2019/fix_ticket2238_solution2/src/OCE/ICB/icblbc.F90

@@ -56 +56 @@
 
    INTEGER, PARAMETER, PRIVATE ::   jp_delta_buf = 25             ! Size by which to increment buffers
-   INTEGER, PARAMETER, PRIVATE ::   jp_buffer_width = 15+nkounts  ! items to store for each berg
+   INTEGER, PARAMETER, PRIVATE ::   jp_buffer_width = 47+nkounts  ! items to store for each berg
 
 #endif
@@ -90 +90 @@
          DO WHILE( ASSOCIATED(this) )
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
+            iine = INT( pt%xi + 0.5_wp )
             IF( iine > mig(nicbei) ) THEN
                pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp
@@ -125 +125 @@
       DO WHILE( ASSOCIATED(this) )
          pt => this%current_point
-         ijne = INT( pt%yj + 0.5 )
+         ijne = INT( pt%yj + 0.5_wp )
          IF( ijne .GT. mjg(nicbej) ) THEN
             !
-            iine = INT( pt%xi + 0.5 )
+            iine = INT( pt%xi + 0.5_wp )
             ipts  = nicbfldpts (mi1(iine))
             !
@@ -232 +232 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
+            iine = INT( pt%xi + 0.5_wp )
             IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN
                tmpberg => this
@@ -242 +242 @@
                ENDIF
                ! deal with periodic case
-               tmpberg%current_point%xi = ricb_right + MOD(tmpberg%current_point%xi, 1._wp ) - 1._wp
+               tmpberg%current_point%xi      = ricb_right + MOD(tmpberg%current_point%xi, 1._wp ) - 1._wp
+               tmpberg%current_point%xRK1(1) = ricb_right + MOD(tmpberg%current_point%xRK1(1), 1._wp ) - 1._wp
+               tmpberg%current_point%xRK2(1) = ricb_right + MOD(tmpberg%current_point%xRK2(1), 1._wp ) - 1._wp
+               tmpberg%current_point%xRK3(1) = ricb_right + MOD(tmpberg%current_point%xRK3(1), 1._wp ) - 1._wp
+               tmpberg%current_point%xRK4(1) = ricb_right + MOD(tmpberg%current_point%xRK4(1), 1._wp ) - 1._wp
                ! now pack it into buffer and delete from list
                CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e)
@@ -255 +259 @@
                ENDIF
                ! deal with periodic case
-               tmpberg%current_point%xi = ricb_left + MOD(tmpberg%current_point%xi, 1._wp )
+               tmpberg%current_point%xi      = ricb_left + MOD(tmpberg%current_point%xi, 1._wp )
+               tmpberg%current_point%xRK1(1) = ricb_left + MOD(tmpberg%current_point%xRK1(1), 1._wp )
+               tmpberg%current_point%xRK2(1) = ricb_left + MOD(tmpberg%current_point%xRK2(1), 1._wp )
+               tmpberg%current_point%xRK3(1) = ricb_left + MOD(tmpberg%current_point%xRK3(1), 1._wp )
+               tmpberg%current_point%xRK4(1) = ricb_left + MOD(tmpberg%current_point%xRK4(1), 1._wp )
                ! now pack it into buffer and delete from list
                CALL icb_pack_into_buffer( tmpberg, obuffer_w, ibergs_to_send_w)
@@ -370 +378 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            ijne = INT( pt%yj + 0.5 )
+            ijne = INT( pt%yj + 0.5_wp )
             IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN
                tmpberg => this
@@ -537 +545 @@
          DO WHILE (ASSOCIATED(this))
             pt => this%current_point
-            iine = INT( pt%xi + 0.5 )
-            ijne = INT( pt%yj + 0.5 )
+            iine = INT( pt%xi + 0.5_wp )
+            ijne = INT( pt%yj + 0.5_wp )
             IF( iine .LT. mig(nicbdi) .OR. &
                 iine .GT. mig(nicbei) .OR. &
@@ -544 +552 @@
                 ijne .GT. mjg(nicbej)) THEN
                i = i + 1
-               WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne
-               WRITE(numicb,*) '                   ', nimpp, njmpp
-               WRITE(numicb,*) '                   ', nicbdi, nicbei, nicbdj, nicbej
+               WRITE(numicb,*) 'berg lost in halo:  ', this%number(:),iine,ijne, pt%xi, pt%yj
+               WRITE(numicb,*) 'nimpp, njmpp        ', nimpp, njmpp
+               WRITE(numicb,*) 'nicb di, ei, dj, ej ', nicbdi     , nicbei     , nicbdj     , nicbej
+               WRITE(numicb,*) 'mijg di, ei, dj, ej ', mig(nicbdi), mig(nicbei), mjg(nicbdj), mjg(nicbej)
                CALL flush( numicb )
             ENDIF
@@ -611 +620 @@
                DO WHILE (ASSOCIATED(this))
                   pt => this%current_point
-                  iine = INT( pt%xi + 0.5 )
-                  ijne = INT( pt%yj + 0.5 )
+                  iine = INT( pt%xi + 0.5_wp )
+                  ijne = INT( pt%yj + 0.5_wp )
                   iproc = nicbflddest(mi1(iine))
                   IF( ijne .GT. mjg(nicbej) ) THEN
@@ -691 +700 @@
                DO WHILE (ASSOCIATED(this))
                   pt => this%current_point
-                  iine = INT( pt%xi + 0.5 )
-                  ijne = INT( pt%yj + 0.5 )
+                  iine = INT( pt%xi + 0.5_wp )
+                  ijne = INT( pt%yj + 0.5_wp )
                   ipts  = nicbfldpts (mi1(iine))
                   iproc = nicbflddest(mi1(iine))
@@ -791 +800 @@
       IF( .NOT. ASSOCIATED(pbuff) ) CALL icb_increase_buffer( pbuff, jp_delta_buf )
       IF( kb .GT. pbuff%size ) CALL icb_increase_buffer( pbuff, jp_delta_buf )
+      IF( kb .GT. pbuff%size ) PRINT *, 'SHOULD NOT SEE THIS'
 
       !! pack points into buffer
@@ -809 +819 @@
       pbuff%data(14,kb) = berg%current_point%heat_density
 
-      pbuff%data(15,kb) = berg%mass_scaling
+      pbuff%data(15:18,kb) = berg%current_point%xRK1
+      pbuff%data(19:22,kb) = berg%current_point%xRK2
+      pbuff%data(23:26,kb) = berg%current_point%xRK3
+      pbuff%data(27:30,kb) = berg%current_point%xRK4
+
+      pbuff%data(31:34,kb) = berg%current_point%yRK1
+      pbuff%data(35:38,kb) = berg%current_point%yRK2
+      pbuff%data(39:42,kb) = berg%current_point%yRK3
+      pbuff%data(43:46,kb) = berg%current_point%yRK4
+
+      pbuff%data(47,kb) = berg%mass_scaling
       DO k=1,nkounts
-         pbuff%data(15+k,kb) = REAL( berg%number(k), wp )
+         pbuff%data(47+k,kb) = REAL( berg%number(k), wp )
       END DO
       !
@@ -844 +864 @@
       pt%heat_density   =      pbuff%data(14,kb)
 
-      currentberg%mass_scaling =      pbuff%data(15,kb)
+      pt%xRK1 = pbuff%data(15:18,kb)
+      pt%xRK2 = pbuff%data(19:22,kb) 
+      pt%xRK3 = pbuff%data(23:26,kb)
+      pt%xRK4 = pbuff%data(27:30,kb)
+
+      pt%yRK1 = pbuff%data(31:34,kb)
+      pt%yRK2 = pbuff%data(35:38,kb)
+      pt%yRK3 = pbuff%data(39:42,kb)
+      pt%yRK4 = pbuff%data(43:46,kb)
+
+      currentberg%mass_scaling =      pbuff%data(47,kb)
       DO ik = 1, nkounts
-         currentberg%number(ik) = INT( pbuff%data(15+ik,kb) )
+         currentberg%number(ik) = INT( pbuff%data(47+ik,kb) )
       END DO
       !