/[MITgcm]/MITgcm_contrib/darwin2/pkg/monod/monod_init_vari.F
ViewVC logotype

Diff of /MITgcm_contrib/darwin2/pkg/monod/monod_init_vari.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by jahn, Thu Sep 22 16:01:30 2011 UTC revision 1.15 by jahn, Thu May 1 16:19:32 2014 UTC
# Line 41  c ANNA define params for WAVEBANDS Line 41  c ANNA define params for WAVEBANDS
41  #endif  #endif
42    
43    
44  C !INPUT PARAMETERS: ===================================================  C     !INPUT PARAMETERS: ===================================================
45  C  myThid               :: thread number  C     myThid               :: thread number
46        INTEGER myThid        INTEGER myThid
47    CEOP
48    
49  C     === Functions ===  C     !FUNCTIONS:
50        _RL DARWIN_RANDOM        _RL DARWIN_RANDOM
51        EXTERNAL DARWIN_RANDOM        EXTERNAL DARWIN_RANDOM
52    
53  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
 C     === Local variables ===  
54  C     msgBuf    - Informational/error meesage buffer  C     msgBuf    - Informational/error meesage buffer
55        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
56        INTEGER IniUnit1, IniUnit2        INTEGER IniUnit1, IniUnit2
57    
58          INTEGER bi, bj, k, i, j, iPAR        INTEGER bi, bj, k, i, j, iPAR
59    
60          INTEGER np        INTEGER np
61          INTEGER nz        INTEGER nz
62  c ANNA need nl for wavebands  c ANNA need nl for wavebands
63  #ifdef WAVEBANDS  #ifdef WAVEBANDS
64          integer ilam        INTEGER ilam
65          integer nl        INTEGER nl
66          _RL cu_area        _RL cu_area
67  #endif  #endif
68    
69  CEOP  C ----------------------------------------------------------------------
70    C Scalar bits first
71          _BEGIN_MASTER( myThid )
72    
73          WRITE(msgBuf,'(A)')          WRITE(msgBuf,'(A)')
74       &  '// ======================================================='       &  '// ======================================================='
# Line 80  CEOP Line 82  CEOP
82          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
83       &                      SQUEEZE_RIGHT, myThid )       &                      SQUEEZE_RIGHT, myThid )
84    
 c test....................  
 c       write(6,*)'testing in npzd2fe_init_vari '  
 c test....................  
       
   
85  c set up ecosystem coefficients  c set up ecosystem coefficients
86  c  c
87  c seed randomization  c seed randomization
88    
89          CALL DARWIN_RANDOM_INIT(darwin_seed, myThid)          CALL DARWIN_RANDOM_INIT(darwin_seed, myThid)
90    
91  c initialize total number of functional groups tried  c initialize total number of functional groups tried
# Line 100  c initialize total number of functional Line 98  c initialize total number of functional
98  #endif  #endif
99           end do           end do
100    
 c reduce amount of diaz  
 #ifdef ALLOW_DIAZ  
         do np = 1, npmax  
          if (diazotroph(np) .eq. 1. _d 0) then  
          DO bj = myByLo(myThid), myByHi(myThid)  
           DO bi = myBxLo(myThid), myBxHi(myThid)  
            DO j=1-Oly,sNy+Oly  
             DO i=1-Olx,sNx+Olx  
              DO k=1,nR  
                Ptracer(i,j,k,bi,bj,iPhy+np-1) =    
      &                Ptracer(i,j,k,bi,bj,iPhy+np-1)/10. _d 0  
              ENDDO  
             ENDDO  
            ENDDO  
           ENDDO  
          ENDDO  
          endif  
         enddo  
 #endif  
   
101  c initialize zooplankton  c initialize zooplankton
102           call MONOD_GENERATE_ZOO(MyThid)           call MONOD_GENERATE_ZOO(MyThid)
103    
# Line 179  c  no temp/nutrient limitation Line 157  c  no temp/nutrient limitation
157       &               (2*pcmax(np)))       &               (2*pcmax(np)))
158             enddo             enddo
159  #endif  #endif
            call MONOD_CHECK_CHL(myThid)  
160  #endif  #endif
161  #endif  #endif
 c ANNA endif  
162    
163           IF ( myProcId.EQ.0 .AND. myThid.EQ.1 ) THEN           IF ( myProcId.EQ.0 .AND. myThid.EQ.1 ) THEN
164  c write out initial phyto characteristics  c write out initial phyto characteristics
# Line 279  c ANNA outputs mQyield as 10^(4) mmol C Line 255  c ANNA outputs mQyield as 10^(4) mmol C
255           close(IniUnit1)           close(IniUnit1)
256   110     format(3f4.0,f6.2,4f4.0,f5.1,4f7.3,2e11.2,2f9.4,f6.1,2i5)   110     format(3f4.0,f6.2,4f4.0,f5.1,4f7.3,2e11.2,2f9.4,f6.1,2i5)
257   111     format(3f4.0,f6.2,4f4.0,f5.1,4f7.3,2f6.1,2f9.4,f6.1,2i5)   111     format(3f4.0,f6.2,4f4.0,f5.1,4f7.3,2f6.1,2f9.4,f6.1,2i5)
258    
259    #ifdef CHECK_CONS
260    coj find unused units for darwin_cons output
261            CALL MDSFINDUNIT( DAR_cons_unitP, mythid )
262            open(DAR_cons_unitP,file='darwin_cons_P.txt',status='unknown')
263            CALL MDSFINDUNIT( DAR_cons_unitN, mythid )
264            open(DAR_cons_unitN,file='darwin_cons_N.txt',status='unknown')
265            CALL MDSFINDUNIT( DAR_cons_unitF, mythid )
266            open(DAR_cons_unitF,file='darwin_cons_Fe.txt',status='unknown')
267            CALL MDSFINDUNIT( DAR_cons_unitS, mythid )
268            open(DAR_cons_unitS,file='darwin_cons_Si.txt',status='unknown')
269    #ifdef ALLOW_CARBON
270            CALL MDSFINDUNIT( DAR_cons_unitC, mythid )
271            open(DAR_cons_unitC,file='darwin_cons_C.txt',status='unknown')
272            CALL MDSFINDUNIT( DAR_cons_unitA, mythid )
273            open(DAR_cons_unitA,file='darwin_cons_A.txt',status='unknown')
274            CALL MDSFINDUNIT( DAR_cons_unitO, mythid )
275            open(DAR_cons_unitO,file='darwin_cons_O.txt',status='unknown')
276    #endif
277    #endif
278    
279  c       myProcId and myThid  c       myProcId and myThid
280          ENDIF          ENDIF
281    
282            WRITE(msgBuf,'(A)')
283         &  '// ======================================================='
284            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
285         &                      SQUEEZE_RIGHT, myThid )
286            WRITE(msgBuf,'(A)') '// Darwin init variables >>> END <<<'
287            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
288         &                      SQUEEZE_RIGHT, myThid )
289            WRITE(msgBuf,'(A)')
290         &  '// ======================================================='
291            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
292         &                      SQUEEZE_RIGHT, myThid )
293    
294          _END_MASTER( myThid )
295          _BARRIER
296    
297    C ----------------------------------------------------------------------
298    C From here on we do actual 3d stuff appropriate for init_varia
299    
300    c reduce amount of diaz
301    #ifdef ALLOW_DIAZ
302           IF (nIter0.EQ.PTRACERS_Iter0) THEN
303            do np = 1, npmax
304             if (diazotroph(np) .eq. 1. _d 0) then
305             DO bj = myByLo(myThid), myByHi(myThid)
306              DO bi = myBxLo(myThid), myBxHi(myThid)
307               DO j=1-Oly,sNy+Oly
308                DO i=1-Olx,sNx+Olx
309                 DO k=1,nR
310                   Ptracer(i,j,k,bi,bj,iPhy+np-1) =
311         &                Ptracer(i,j,k,bi,bj,iPhy+np-1)/10. _d 0
312                 ENDDO
313                ENDDO
314               ENDDO
315              ENDDO
316             ENDDO
317             endif
318            enddo
319           ENDIF
320    #endif
321    
322    #ifdef FIX_ZOO_QUOTAS
323            do nz = 1, nzmax
324             DO bj = myByLo(myThid), myByHi(myThid)
325              DO bi = myBxLo(myThid), myBxHi(myThid)
326               DO j=1-Oly,sNy+Oly
327                DO i=1-Olx,sNx+Olx
328                 DO k=1,nR
329                   Ptracer(i,j,k,bi,bj,iZooN(nz)) =
330         &         Ptracer(i,j,k,bi,bj,iZooP(nz))*R_NP_zoo(nz)
331                   Ptracer(i,j,k,bi,bj,iZooFe(nz)) =
332         &         Ptracer(i,j,k,bi,bj,iZooP(nz))*R_FeP_zoo(nz)
333                   Ptracer(i,j,k,bi,bj,iZooSi(nz)) =
334         &         Ptracer(i,j,k,bi,bj,iZooP(nz))*R_SiP_zoo(nz)
335                   Ptracer(i,j,k,bi,bj,iZooC(nz)) =
336         &         Ptracer(i,j,k,bi,bj,iZooP(nz))*R_PC_zoo(nz)
337                 ENDDO
338                ENDDO
339               ENDDO
340              ENDDO
341             ENDDO
342            enddo
343    #endif
344    
345    #ifdef GEIDER
346    C this initializes fields...
347            call MONOD_CHECK_CHL(myThid)
348    #endif
349    
350           CALL LEF_ZERO( fice,myThid )           CALL LEF_ZERO( fice,myThid )
351           CALL LEF_ZERO( inputFe,myThid )           CALL LEF_ZERO( inputFe,myThid )
352           CALL LEF_ZERO( sur_par,myThid )           CALL LEF_ZERO( sur_par,myThid )
# Line 313  c       myProcId and myThid Line 378  c       myProcId and myThid
378          ENDDO          ENDDO
379         ENDDO         ENDDO
380        ENDDO        ENDDO
381    #endif
382    
383        IF ( .NOT. ( startTime .EQ. baseTime .AND.  nIter0 .EQ. 0        IF ( .NOT. ( startTime .EQ. baseTime .AND.  nIter0 .EQ. 0
384       &     .AND. pickupSuff .EQ. ' ') ) THEN       &     .AND. pickupSuff .EQ. ' ') ) THEN
385  COJ should probably initialize from a file when nIter0 .EQ. 0  COJ should probably initialize from a file when nIter0 .EQ. 0
386          CALL DARWIN_READ_PICKUP( nIter0, myThid )          CALL DARWIN_READ_PICKUP( nIter0, myThid )
387        ENDIF        ENDIF
 #endif  
388  c  c
389  #ifdef ALLOW_TIMEAVE  #ifdef ALLOW_TIMEAVE
390  c set arrays to zero if first timestep  c set arrays to zero if first timestep
# Line 329  c set arrays to zero if first timestep Line 395  c set arrays to zero if first timestep
395            CALL TIMEAVE_RESET(Chlave,   Nr,  bi, bj, myThid)            CALL TIMEAVE_RESET(Chlave,   Nr,  bi, bj, myThid)
396            CALL TIMEAVE_RESET(Nfixave,   Nr,  bi, bj, myThid)            CALL TIMEAVE_RESET(Nfixave,   Nr,  bi, bj, myThid)
397            CALL TIMEAVE_RESET(Denitave,   Nr,  bi, bj, myThid)            CALL TIMEAVE_RESET(Denitave,   Nr,  bi, bj, myThid)
398    #ifdef DAR_DIAG_PARW
399              do i=1,tlam
400               CALL TIMEAVE_RESET(PARwave(1-OLx,1-OLy,1,1,1,i),
401         &                                    Nr,bi,bj,myThid)
402              enddo
403              do np=1,npmax
404               CALL TIMEAVE_RESET(chl2cave(1-OLx,1-OLy,1,1,1,np),
405         &                                    Nr,bi,bj,myThid)
406              enddo
407    #endif
408  #ifdef DAR_DIAG_ACDOM  #ifdef DAR_DIAG_ACDOM
409            CALL TIMEAVE_RESET(aCDOMave,   Nr,  bi, bj, myThid)            CALL TIMEAVE_RESET(aCDOMave,   Nr,  bi, bj, myThid)
410  #endif  #endif
# Line 340  c set arrays to zero if first timestep Line 416  c set arrays to zero if first timestep
416       &                                    Nr,bi,bj,myThid)       &                                    Nr,bi,bj,myThid)
417             CALL TIMEAVE_RESET(Euave(1-OLx,1-OLy,1,1,1,i),             CALL TIMEAVE_RESET(Euave(1-OLx,1-OLy,1,1,1,i),
418       &                                    Nr,bi,bj,myThid)       &                                    Nr,bi,bj,myThid)
419               CALL TIMEAVE_RESET(Estave(1-OLx,1-OLy,1,1,1,i),
420         &                                    Nr,bi,bj,myThid)
421             CALL TIMEAVE_RESET(Eutave(1-OLx,1-OLy,1,1,1,i),             CALL TIMEAVE_RESET(Eutave(1-OLx,1-OLy,1,1,1,i),
422       &                                    Nr,bi,bj,myThid)       &                                    Nr,bi,bj,myThid)
423            enddo            enddo
424  #endif  #endif
425    #ifdef DAR_DIAG_IRR_AMPS
426              do i=1,tlam
427               CALL TIMEAVE_RESET(amp1ave(1-OLx,1-OLy,1,1,1,i),
428         &                                    Nr,bi,bj,myThid)
429               CALL TIMEAVE_RESET(amp2ave(1-OLx,1-OLy,1,1,1,i),
430         &                                    Nr,bi,bj,myThid)
431              enddo
432    #endif
433  #ifdef DAR_DIAG_ABSORP  #ifdef DAR_DIAG_ABSORP
434            do i=1,tlam            do i=1,tlam
435             CALL TIMEAVE_RESET(aave(1-OLx,1-OLy,1,1,1,i),             CALL TIMEAVE_RESET(aave(1-OLx,1-OLy,1,1,1,i),
# Line 368  c set arrays to zero if first timestep Line 454  c set arrays to zero if first timestep
454       &                                    Nr,bi,bj,myThid)       &                                    Nr,bi,bj,myThid)
455            enddo            enddo
456  #endif  #endif
457    #ifdef DAR_RADTRANS
458              CALL TIMEAVE_RESET(rmudave(1-OLx,1-OLy,1,1),
459         &                                   1,bi,bj,myThid)
460    #endif
461  c ANNA_TAVE  c ANNA_TAVE
462  #ifdef WAVES_DIAG_PCHL  #ifdef WAVES_DIAG_PCHL
463            do np=1,npmax            do np=1,npmax
# Line 376  c ANNA_TAVE Line 466  c ANNA_TAVE
466            enddo            enddo
467  #endif  #endif
468  c ANNA end TAVE  c ANNA end TAVE
469    #ifdef DAR_DIAG_EK
470               do np=1,npmax
471               CALL TIMEAVE_RESET(Ekave(1-OLx,1-OLy,1,1,1,np),
472         &                                      Nr,bi,bj,myThid)
473               CALL TIMEAVE_RESET(EkoverEave(1-OLx,1-OLy,1,1,1,np),
474         &                                      Nr,bi,bj,myThid)
475               do i=1,tlam
476                 CALL TIMEAVE_RESET(Ek_nlave(1-OLx,1-OLy,1,1,1,np,i),
477         &                                      Nr,bi,bj,myThid)
478                 CALL TIMEAVE_RESET(EkoverE_nlave(1-OLx,1-OLy,1,1,1,np,i),
479         &                                      Nr,bi,bj,myThid)
480               enddo
481              enddo
482    #endif
483  #ifdef DAR_DIAG_RSTAR  #ifdef DAR_DIAG_RSTAR
484            do np=1,npmax            do np=1,npmax
485             CALL TIMEAVE_RESET(Rstarave(1-OLx,1-OLy,1,1,1,np),             CALL TIMEAVE_RESET(Rstarave(1-OLx,1-OLy,1,1,1,np),
# Line 399  c ANNA end TAVE Line 503  c ANNA end TAVE
503  #endif  #endif
504  #endif  #endif
505  c         CALL TIMEAVE_RESET(SURave,   1,  bi, bj, myThid)  c         CALL TIMEAVE_RESET(SURave,   1,  bi, bj, myThid)
           WRITE(msgbuf,'(A)')  
      &      'QQ start timeave'  
           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                        SQUEEZE_RIGHT , mythid)  
506    
507            do k=1,Nr            DAR_timeAve(bi,bj)=0. _d 0
             DAR_TimeAve(bi,bj,k)=0. _d 0  
           enddo  
508           ENDDO           ENDDO
509          ENDDO          ENDDO
510  #endif /* ALLOW_TIMEAVE */  #endif /* ALLOW_TIMEAVE */
511    
 #ifdef CHECK_CONS  
        IF ( myProcId.EQ.0 .AND. myThid.EQ.1 ) THEN  
 coj find unused units for darwin_cons output  
         CALL MDSFINDUNIT( DAR_cons_unit1, mythid )  
         open(DAR_cons_unit1,file='darwin_cons_P.txt',status='unknown')  
         CALL MDSFINDUNIT( DAR_cons_unit2, mythid )  
         open(DAR_cons_unit2,file='darwin_cons_N.txt',status='unknown')  
         CALL MDSFINDUNIT( DAR_cons_unit3, mythid )  
         open(DAR_cons_unit3,file='darwin_cons_Fe.txt',status='unknown')  
         CALL MDSFINDUNIT( DAR_cons_unit4, mythid )  
         open(DAR_cons_unit4,file='darwin_cons_Si.txt',status='unknown')  
 #ifdef ALLOW_CARBON  
         CALL MDSFINDUNIT( DAR_cons_unit5, mythid )  
         open(DAR_cons_unit5,file='darwin_cons_C.txt',status='unknown')  
         CALL MDSFINDUNIT( DAR_cons_unit6, mythid )  
         open(DAR_cons_unit6,file='darwin_cons_A.txt',status='unknown')  
         CALL MDSFINDUNIT( DAR_cons_unit7, mythid )  
         open(DAR_cons_unit7,file='darwin_cons_O.txt',status='unknown')  
 #endif  
 c      myProcId and myThid  
        ENDIF  
 #endif  
   
 c test....................  
 c       write(6,*)'finishing darwin_init_vari '  
 c test....................  
         WRITE(msgBuf,'(A)')  
      &  '// ======================================================='  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
         WRITE(msgBuf,'(A)') '// Darwin init variables >>> END <<<'  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
         WRITE(msgBuf,'(A)')  
      &  '// ======================================================='  
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &                      SQUEEZE_RIGHT, myThid )  
   
512    
513           RETURN           RETURN
514           END           END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22