Removed problems for N1p update

inogs · Jan 25, 2018 · f46f4e1 · f46f4e1
1 parent 743a108
commit f46f4e1
Show file tree

Hide file tree

Showing 4 changed files with 51 additions and 28 deletions.
diff --git a/readNutCov.f90 b/readNutCov.f90
@@ -28,40 +28,60 @@ subroutine readNutCov
 !---------------------------------------------------------------------------
 
 
-  !use set_knd
+  use set_knd
   use drv_str
   use grd_str
   use bio_str
-  !use cns_str
   use filenames
-  !use rcfl
 
   use mpi_str
   use pnetcdf
 
   implicit none
 
   integer(i4)            :: stat, ncid, idvar
-  integer(KIND=MPI_OFFSET_KIND)  :: GlobalStart(3), GlobalCount(3)
+  integer(i4)            :: i,j,k
+  !integer(KIND=MPI_OFFSET_KIND)  :: GlobalStart(3), GlobalCount(3)
   real(r4), ALLOCATABLE  :: x3(:,:,:)
 
 
   !write(*,*)trim(RCORR_FILE)
   stat = nf90mpi_open(Var3DCommunicator, trim(NUTCOV_FILE), NF90_NOWRITE, MPI_INFO_NULL, ncid)
   if (stat /= nf90_noerr) call handle_err("nf90mpi_open",stat)
 
-  ALLOCATE ( x3(GlobalRow,GlobalCol,grd%km))
-  GlobalStart(:) = 1
-  GlobalCount(1) = GlobalRow
-  GlobalCount(2) = GlobalCol
-  GlobalCount(3) = grd%km
+  ALLOCATE ( x3(grd%im, grd%jm, grd%km))
+  ALLOCATE ( bio%covn3n_n1p(grd%im, grd%jm, grd%km)); bio%covn3n_n1p(:,:,:) = 0.0
+
+  x3(:,:,:) = 0.0
 
   stat = nf90mpi_inq_varid (ncid, 'covn3n_n1p', idvar)
   if (stat /= nf90_noerr) call handle_err("nf90mpi_inq_varid radius",stat)
-  stat = nfmpi_get_vara_real_all (ncid, idvar, GlobalStart, GlobalCount, x3)
+  stat = nfmpi_get_vara_real_all (ncid, idvar, MyStart, MyCount, x3)
   if (stat /= nf90_noerr) call handle_err("nfmpi_get_vara_real_all radius",stat)
 
-  bio%covn3n_n1p(:,:,:) = x3(:,:,:)
+  do k=1,grd%km
+    do j=1,grd%jm
+      do i=1,grd%im
+        if(x3(i,j,k) .lt. 1.e20) then
+
+          bio%covn3n_n1p(i,j,k) = bio%covn3n_n1p(i,j,k) + x3(i,j,k)
+
+        else
+          bio%covn3n_n1p(i,j,k) = x3(i,j,k)
+          if(grd%msk(i,j,k) .eq. 1) then
+            write(*,*) "Warning!! Bad mask point in N3n N1p covaraince!"
+            write(*,*) "i=",i," j=",j," k=",k
+            write(*,*) "grd%msk(i,j,k)=",grd%msk
+            write(*,*) "bio%covn3n_n1p(i,j,k)=",bio%covn3n_n1p(i,j,k)
+            write(*,*) "Aborting.."
+            call MPI_Abort(Var3DCommunicator, -1, stat)
+          endif
+
+        endif
+
+      enddo
+    enddo
+  enddo
 
 
   stat = nf90mpi_close(ncid)

diff --git a/sav_itr.f90 b/sav_itr.f90
@@ -110,6 +110,10 @@ subroutine sav_itr
     DEALLOCATE( bio%cquot, bio%pquot)
     DEALLOCATE( bio%InitialChl)
   endif
+  if(drv%nut .eq. 1) then
+    DEALLOCATE( bio%InitialNut)
+    DEALLOCATE( bio%covn3n_n1p)
+  endif
 
   DEALLOCATE(SurfaceWaterPoints)  
 

diff --git a/wrt_dia.f90 b/wrt_dia.f90
@@ -135,21 +135,21 @@ subroutine wrt_dia
     if (status .ne. NF90_NOERR ) call handle_err('nf90mpi_put_var_all n3n', status)
   endif
 
-  ! if(drv%nut .eq. 1 .and. bio%n3n .eq. 1 .and. bio%updateN1p .eq. 1) then
-  !   do k=1,grd%km
-  !     do j=1,grd%jm
-  !         do i=1,grd%im
-  !           if(grd%msk(i,j,k) .eq. 1) then
-  !             DumpMatrix(i,j,k) = REAL(grd%n3n(i,j,k)*bio%covn3n_n1p(i,j,k), 4 )
-  !           else
-  !             DumpMatrix(i,j,k) = 1.e20
-  !           endif
-  !         enddo
-  !     enddo
-  !   enddo
-  !   status = nf90mpi_put_var_all(ncid,idn1p,DumpMatrix,MyStart,MyCount)
-  !   if (status .ne. NF90_NOERR ) call handle_err('nf90mpi_put_var_all n1p', status)
-  ! endif
+  if(drv%nut .eq. 1 .and. bio%n3n .eq. 1 .and. bio%updateN1p .eq. 1) then
+    do k=1,grd%km
+      do j=1,grd%jm
+          do i=1,grd%im
+            if(grd%msk(i,j,k) .eq. 1) then
+              DumpMatrix(i,j,k) = REAL(grd%n3n(i,j,k)*bio%covn3n_n1p(i,j,k), 4 )
+            else
+              DumpMatrix(i,j,k) = 1.e20
+            endif
+          enddo
+      enddo
+    enddo
+    status = nf90mpi_put_var_all(ncid,idn1p,DumpMatrix,MyStart,MyCount)
+    if (status .ne. NF90_NOERR ) call handle_err('nf90mpi_put_var_all n1p', status)
+  endif
 
   if(drv%nut .eq. 1 .and. bio%o2o .eq. 1) then
     do k=1,grd%km

diff --git a/wrt_nut_stat.f90 b/wrt_nut_stat.f90
@@ -66,8 +66,7 @@ subroutine wrt_nut_stat
           ! if the correction is negative, the correction must be reduced
           ValuesToTest(i,j,k,1) = bio%InitialNut(i,j,k,1) + grd%n3n(i,j,k)
           if(bio%updateN1p.eq.1) then
-            ValuesToTest(i,j,k,2) = bio%InitialNut(i,j,k,2) + grd%n3n(i,j,k) !*bio%covn3n_n1p(i,j,k)
-            !ValuesToTest(i,j,k,2) = bio%InitialNut(i,j,k,2) + grd%n3n(i,j,k)*bio%covn3n_n1p(i,j,k)
+            ValuesToTest(i,j,k,2) = bio%InitialNut(i,j,k,2) + grd%n3n(i,j,k)*bio%covn3n_n1p(i,j,k)
           endif
         !   if(bio%ApplyConditions) then
         !     !if(ValuesToTest(i,j,k) .gt. 10*bio%InitialChl(i,j,k)) then