- Timestamp:
- 2017-12-26T17:32:56+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zpoc.F90
r9125 r9169 23 23 PUBLIC p4z_poc ! called in p4zbio.F90 24 24 PUBLIC p4z_poc_init ! called in trcsms_pisces.F90 25 PUBLIC alngam 26 PUBLIC gamain 27 28 !! * Shared module variables 29 REAL(wp), PUBLIC :: xremip !: remineralisation rate of DOC 30 REAL(wp), PUBLIC :: xremipc !: remineralisation rate of DOC 31 REAL(wp), PUBLIC :: xremipn !: remineralisation rate of DON 32 REAL(wp), PUBLIC :: xremipp !: remineralisation rate of DOP 33 INTEGER , PUBLIC :: jcpoc !: number of lability classes 34 REAL(wp), PUBLIC :: rshape !: shape factor of the gamma distribution 35 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: alphan, reminp 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap 25 PUBLIC alngam ! 26 PUBLIC gamain ! 27 28 REAL(wp), PUBLIC :: xremip !: remineralisation rate of DOC 29 REAL(wp), PUBLIC :: xremipc !: remineralisation rate of DOC 30 REAL(wp), PUBLIC :: xremipn !: remineralisation rate of DON 31 REAL(wp), PUBLIC :: xremipp !: remineralisation rate of DOP 32 INTEGER , PUBLIC :: jcpoc !: number of lability classes 33 REAL(wp), PUBLIC :: rshape !: shape factor of the gamma distribution 34 35 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: alphan, reminp !: 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: alphap !: 38 37 39 38 … … 53 52 !! ** Method : - ??? 54 53 !!--------------------------------------------------------------------- 55 ! 56 INTEGER, INTENT(in) :: kt, knt ! ocean time step 54 INTEGER, INTENT(in) :: kt, knt ! ocean time step and ??? 57 55 ! 58 56 INTEGER :: ji, jj, jk, jn … … 187 185 END DO 188 186 189 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )190 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )187 IF( ln_p4z ) THEN ; zremigoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 188 ELSE ; zremigoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 191 189 ENDIF 192 190 … … 260 258 ! ------------------------------------------------------------------- 261 259 ! 262 totprod (:,:) = 0.260 totprod (:,:) = 0. 263 261 totthick(:,:) = 0. 264 totcons (:,:) = 0.262 totcons (:,:) = 0. 265 263 ! intregrated production and consumption of POC in the mixed layer 266 264 ! ---------------------------------------------------------------- … … 396 394 END DO 397 395 398 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) )399 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) )396 IF( ln_p4z ) THEN ; zremipoc(:,:,:) = MIN( xremip , ztremint(:,:,:) ) 397 ELSE ; zremipoc(:,:,:) = MIN( xremipc, ztremint(:,:,:) ) 400 398 ENDIF 401 399 … … 473 471 !! 474 472 !! ** Method : Read the nampispoc namelist and check the parameters 475 !! called at the first timestep473 !! called at the first timestep 476 474 !! 477 475 !! ** input : Namelist nampispoc 478 !!479 476 !!---------------------------------------------------------------------- 477 INTEGER :: jn ! dummy loop index 480 478 INTEGER :: ios, ifault ! Local integer 481 INTEGER :: jn 482 REAL(wp) :: remindelta, reminup, remindown 479 REAL(wp):: remindelta, reminup, remindown 483 480 !! 484 481 NAMELIST/nampispoc/ xremip , jcpoc , rshape, & 485 482 & xremipc, xremipn, xremipp 486 483 !!---------------------------------------------------------------------- 487 484 ! 485 IF(lwp) THEN 486 WRITE(numout,*) 487 WRITE(numout,*) 'p4z_poc_init : Initialization of remineralization parameters' 488 WRITE(numout,*) '~~~~~~~~~~~~' 489 ENDIF 490 ! 488 491 REWIND( numnatp_ref ) ! Namelist nampisrem in reference namelist : Pisces remineralization 489 492 READ ( numnatp_ref, nampispoc, IOSTAT = ios, ERR = 901) 490 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 491 493 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampispoc in reference namelist', lwp ) 492 494 REWIND( numnatp_cfg ) ! Namelist nampisrem in configuration namelist : Pisces remineralization 493 495 READ ( numnatp_cfg, nampispoc, IOSTAT = ios, ERR = 902 ) 494 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp )495 IF(lwm) WRITE 496 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampispoc in configuration namelist', lwp ) 497 IF(lwm) WRITE( numonp, nampispoc ) 496 498 497 499 IF(lwp) THEN ! control print 498 WRITE(numout,*) ' ' 499 WRITE(numout,*) ' Namelist parameters for remineralization, nampispoc' 500 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 500 WRITE(numout,*) ' Namelist : nampispoc' 501 501 IF( ln_p4z ) THEN 502 WRITE(numout,*) ' remineralisation rate of POC xremip =', xremip502 WRITE(numout,*) ' remineralisation rate of POC xremip =', xremip 503 503 ELSE 504 WRITE(numout,*) ' remineralisation rate of POC xremipc =', xremipc505 WRITE(numout,*) ' remineralisation rate of PON xremipn =', xremipn506 WRITE(numout,*) ' remineralisation rate of POP xremipp =', xremipp504 WRITE(numout,*) ' remineralisation rate of POC xremipc =', xremipc 505 WRITE(numout,*) ' remineralisation rate of PON xremipn =', xremipn 506 WRITE(numout,*) ' remineralisation rate of POP xremipp =', xremipp 507 507 ENDIF 508 WRITE(numout,*) ' Number of lability classes for POC jcpoc =', jcpoc509 WRITE(numout,*) ' Shape factor of the gamma distribution rshape =', rshape508 WRITE(numout,*) ' Number of lability classes for POC jcpoc =', jcpoc 509 WRITE(numout,*) ' Shape factor of the gamma distribution rshape =', rshape 510 510 ENDIF 511 511 ! … … 513 513 ! --------------------------------------- 514 514 ! 515 ALLOCATE( alphan(jcpoc), reminp(jcpoc) ) 516 ALLOCATE( alphap(jpi,jpj,jpk,jcpoc) ) 515 ALLOCATE( alphan(jcpoc) , reminp(jcpoc) , alphap(jpi,jpj,jpk,jcpoc) ) 517 516 ! 518 517 IF (jcpoc > 1) THEN … … 551 550 END SUBROUTINE p4z_poc_init 552 551 552 553 553 REAL FUNCTION alngam( xvalue, ifault ) 554 555 !*****************************************************************************80 556 ! 557 !! ALNGAM computes the logarithm of the gamma function. 558 ! 559 ! Modified: 560 ! 561 ! 13 January 2008 562 ! 563 ! Author: 564 ! 565 ! Allan Macleod 566 ! FORTRAN90 version by John Burkardt 567 ! 568 ! Reference: 569 ! 570 ! Allan Macleod, 571 ! Algorithm AS 245, 572 ! A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 573 ! Applied Statistics, 574 ! Volume 38, Number 2, 1989, pages 397-402. 575 ! 576 ! Parameters: 577 ! 578 ! Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 579 ! 580 ! Output, integer ( kind = 4 ) IFAULT, error flag. 581 ! 0, no error occurred. 582 ! 1, XVALUE is less than or equal to 0. 583 ! 2, XVALUE is too big. 584 ! 585 ! Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 586 ! 554 !*****************************************************************************80 555 ! 556 !! ALNGAM computes the logarithm of the gamma function. 557 ! 558 ! Modified: 13 January 2008 559 ! 560 ! Author : Allan Macleod 561 ! FORTRAN90 version by John Burkardt 562 ! 563 ! Reference: 564 ! Allan Macleod, Algorithm AS 245, 565 ! A Robust and Reliable Algorithm for the Logarithm of the Gamma Function, 566 ! Applied Statistics, 567 ! Volume 38, Number 2, 1989, pages 397-402. 568 ! 569 ! Parameters: 570 ! 571 ! Input, real ( kind = 8 ) XVALUE, the argument of the Gamma function. 572 ! 573 ! Output, integer ( kind = 4 ) IFAULT, error flag. 574 ! 0, no error occurred. 575 ! 1, XVALUE is less than or equal to 0. 576 ! 2, XVALUE is too big. 577 ! 578 ! Output, real ( kind = 8 ) ALNGAM, the logarithm of the gamma function of X. 579 !*****************************************************************************80 587 580 implicit none 588 581 … … 746 739 END FUNCTION alngam 747 740 741 748 742 REAL FUNCTION gamain( x, p, ifault ) 749 750 743 !*****************************************************************************80 751 744 !
Note: See TracChangeset
for help on using the changeset viewer.
