Changeset 8280
- Timestamp:
- 2017-07-05T10:28:51+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package/NEMOGCM
- Files:
-
- 37 edited
- 16 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/CONFIG/SHARED/namelist_cfc_ref
r4147 r8280 7 7 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,, 8 8 ndate_beg = 300101 ! datedeb1 9 nyear_res = 1932 ! iannee1 9 nyear_res = 1600 ! iannee1 10 simu_type = 1 ! kind of Simulation: 1 = SPIN-UP (90y-cycle) 11 !! !! 2 = Hindcast/proj (100y cycle) 10 12 / 11 13 !''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/CONFIG/SHARED/namelist_ref
r8046 r8280 363 363 sn_snd_crt = 'none' , 'no' , 'spherical' , 'eastward-northward' , 'T' 364 364 sn_snd_co2 = 'coupled' , 'no' , '' , '' , '' 365 sn_snd_bio_co2 = 'medusa' , 'no' , '' , '' , '' 366 sn_snd_bio_dms = 'medusa' , 'no' , '' , '' , '' 367 sn_snd_bio_chloro = 'medusa' , 'no' , '' , '' , '' 368 sn_snd_cond = 'weighted ice' , 'no' , '' , '' , '' 369 sn_snd_mpnd = 'ice only' , 'no' , '' , '' , '' 370 sn_snd_sstfrz = 'coupled' , 'no' , '' , '' , '' 371 sn_snd_thick1 = 'ice and snow' , 'no' , '' , '' , '' 365 372 ! receive 366 373 sn_rcv_w10m = 'none' , 'no' , '' , '' , '' … … 374 381 sn_rcv_cal = 'coupled' , 'no' , '' , '' , '' 375 382 sn_rcv_co2 = 'coupled' , 'no' , '' , '' , '' 383 sn_rcv_antm = 'coupled' , 'no' , '' , '' , '' 384 sn_rcv_grnm = 'coupled' , 'no' , '' , '' , '' 385 sn_rcv_iceflx = 'coupled' , 'no' , '' , '' , '' 386 sn_rcv_ts_ice = 'ice' , 'no' , '' , '' , '' 387 sn_rcv_atm_dust = 'medusa' , 'no' , '' , '' , '' 388 sn_rcv_atm_pco2 = 'medusa' , 'no' , '' , '' , '' 389 376 390 ! 377 391 nn_cplmodel = 1 ! Maximum number of models to/from which NEMO is potentialy sending/receiving data -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/CONFIG/cfg.txt
r6498 r8280 11 11 GYRE OPA_SRC 12 12 ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC 13 ORCA2_OFF_MEDUSA OPA_SRC OFF_SRC TOP_SRC -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90
r6486 r8280 124 124 125 125 CASE DEFAULT 126 IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' 127 STOP 'dia_wri_dimg' 126 127 WRITE(numout,*) 'dia_wri_dimg : E R R O R : bad cd_type in dia_wri_dimg' 128 CALL ctl_stop( 'STOP', 'dia_wri_dimg :bad cd_type in dia_wri_dimg ' ) 128 129 129 130 END SELECT -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7651 r8280 1116 1116 ENDIF 1117 1117 #endif 1118 1119 IF (cdfile_name == "output.abort") THEN 1120 CALL ctl_stop('MPPSTOP', 'NEMO abort from dia_wri_state') 1121 END IF 1118 1122 1119 1123 ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r6486 r8280 112 112 IF( inbsel > jpk ) THEN 113 113 IF(lwp) WRITE(numout,*) ' STOP inbsel =',inbsel,' is larger than jpk=',jpk 114 STOP114 CALL ctl_stop('STOP', 'NEMO aborted from dia_wri') 115 115 ENDIF 116 116 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r6491 r8280 550 550 IF(lwp) WRITE(numout,*) 'dom_msk_nsa : noslip accurate boundary condition' 551 551 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ using Schchepetkin and O Brian scheme' 552 IF( lk_mpp ) CALL ctl_stop( ' mpp version is not yet implemented' )552 IF( lk_mpp ) CALL ctl_stop('STOP', ' mpp version is not yet implemented' ) 553 553 554 554 ! mask for second order calculation of vorticity … … 572 572 WRITE(numout,*) ' symetric boundary conditions need special' 573 573 WRITE(numout,*) ' treatment not implemented. we stop.' 574 STOP574 CALL ctl_stop('STOP', 'NEMO abort from dom_msk_nsa') 575 575 ENDIF 576 576 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r6486 r8280 465 465 END DO 466 466 ELSE 467 IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 468 IF(lwp)WRITE(numout,*) ' We stop' 469 STOP 'ldfguv' 467 468 WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm 469 WRITE(numout,*) ' We stop' 470 CALL ctl_stop('STOP', 'ldfguv: Unexpected kahm value') 471 470 472 ENDIF 471 473 ! ! =============== -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r6486 r8280 38 38 USE wrk_nemo ! Memory Allocation 39 39 USE timing ! Timing 40 USE lib_fortran 40 41 41 42 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r7993 r8280 2049 2049 2050 2050 SUBROUTINE mppstop 2051 2052 #if defined key_oasis3 2053 USE mod_oasis ! coupling routines 2054 #endif 2055 2051 2056 !!---------------------------------------------------------------------- 2052 2057 !! *** routine mppstop *** … … 2058 2063 !!---------------------------------------------------------------------- 2059 2064 ! 2065 2066 #if defined key_oasis3 2067 ! If we're trying to shut down cleanly then we need to consider the fact 2068 ! that this could be part of an MPMD configuration - we don't want to 2069 ! leave other components deadlocked. 2070 2071 CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 2072 2073 2074 #else 2075 2060 2076 CALL mppsync 2061 2077 CALL mpi_finalize( info ) 2078 #endif 2079 2062 2080 ! 2063 2081 END SUBROUTINE mppstop … … 3884 3902 IF( numevo_ice /= -1 ) CALL FLUSH(numevo_ice) 3885 3903 ! 3904 IF( cd1 == 'MPPSTOP' ) THEN 3905 IF(lwp) WRITE(numout,*) 'E R R O R: Calling mppstop' 3906 CALL mppstop() 3907 ENDIF 3886 3908 IF( cd1 == 'STOP' ) THEN 3887 3909 IF(lwp) WRITE(numout,*) 'huge E-R-R-O-R : immediate stop' … … 3988 4010 WRITE(kout,*) 3989 4011 ENDIF 3990 STOP 'ctl_opn bad opening'4012 CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 3991 4013 ENDIF 3992 4014 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/cpl_oasis3.F90
r6486 r8280 31 31 USE in_out_manager ! I/O manager 32 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 33 34 34 IMPLICIT NONE 35 35 PRIVATE … … 41 41 PUBLIC cpl_freq 42 42 PUBLIC cpl_finalize 43 #if defined key_mpp_mpi 44 INCLUDE 'mpif.h' 45 #endif 46 47 INTEGER, PARAMETER :: localRoot = 0 48 LOGICAL :: commRank ! true for ranks doing OASIS communication 49 #if defined key_cpl_rootexchg 50 LOGICAL :: rootexchg =.true. ! logical switch 51 #else 52 LOGICAL :: rootexchg =.false. ! logical switch 53 #endif 43 54 44 55 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 82 93 83 94 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 84 95 INTEGER, PUBLIC :: localComm 96 85 97 !!---------------------------------------------------------------------- 86 98 !! NEMO/OPA 3.3 , NEMO Consortium (2010) … … 120 132 IF ( nerror /= OASIS_Ok ) & 121 133 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 134 localComm = kl_comm 122 135 ! 123 136 END SUBROUTINE cpl_init … … 177 190 IF( nerror > 0 ) THEN 178 191 CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld') ; RETURN 179 ENDIF 192 ENDIF 180 193 ! 181 194 ! ----------------------------------------------------------------- 182 195 ! ... Define the partition 183 196 ! ----------------------------------------------------------------- 184 197 185 198 paral(1) = 2 ! box partitioning 186 199 paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1) ! NEMO lower left corner global offset … … 196 209 ENDIF 197 210 198 CALL oasis_def_partition ( id_part, paral, nerror 211 CALL oasis_def_partition ( id_part, paral, nerror, jpiglo*jpjglo) 199 212 ! 200 213 ! ... Announce send variables. … … 241 254 END DO 242 255 ENDIF 243 END DO 256 END DO 244 257 ! 245 258 ! ... Announce received variables. … … 373 386 IF( srcv(kid)%nid(jc,jm) /= -1 ) THEN 374 387 375 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 388 CALL oasis_get ( srcv(kid)%nid(jc,jm), kstep, exfld, kinfo ) 376 389 377 390 llaction = kinfo == OASIS_Recvd .OR. kinfo == OASIS_FromRest .OR. & … … 384 397 kinfo = OASIS_Rcv 385 398 IF( llfisrt ) THEN 386 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 399 pdata(nldi:nlei,nldj:nlej,jc) = exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 387 400 llfisrt = .FALSE. 388 401 ELSE … … 463 476 CALL oasis_get_freqs(id, mop, 1, itmp, info) 464 477 #else 478 #if defined key_oasis3 479 itmp(1) = namflddti( id ) 480 #else 465 481 CALL oasis_get_freqs(id, 1, itmp, info) 482 #endif 466 483 #endif 467 484 cpl_freq = itmp(1) … … 514 531 END SUBROUTINE oasis_get_localcomm 515 532 516 SUBROUTINE oasis_def_partition(k1,k2,k3 )533 SUBROUTINE oasis_def_partition(k1,k2,k3,K4) 517 534 INTEGER , INTENT( out) :: k1,k3 518 535 INTEGER , INTENT(in ) :: k2(5) 536 INTEGER , OPTIONAL, INTENT(in ) :: k4 519 537 k1 = k2(1) ; k3 = k2(5) 520 538 WRITE(numout,*) 'oasis_def_partition: Error you sould not be there...' -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r6486 r8280 51 51 52 52 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 53 px2 , py2 )53 px2 , py2 , kchoix ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE repcmo *** … … 68 68 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 69 69 !!---------------------------------------------------------------------- 70 71 ! Change from geographic to stretched coordinate 72 ! ---------------------------------------------- 73 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 74 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 75 70 INTEGER, INTENT( IN ) :: & 71 kchoix ! type of transformation 72 ! = 1 change from geographic to model grid. 73 ! =-1 change from model to geographic grid 74 !!---------------------------------------------------------------------- 75 76 SELECT CASE (kchoix) 77 CASE ( 1) 78 ! Change from geographic to stretched coordinate 79 ! ---------------------------------------------- 80 81 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 82 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 83 CASE (-1) 84 ! Change from stretched to geographic coordinate 85 ! ---------------------------------------------- 86 87 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 88 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 89 END SELECT 90 76 91 END SUBROUTINE repcmo 77 92 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8046 r8280 34 34 USE geo2ocean ! 35 35 USE oce , ONLY : tsn, un, vn, sshn, ub, vb, sshb, fraqsr_1lev, & 36 CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, Dust_in_cpl, & 36 CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl, & 37 PCO2a_in_cpl, Dust_in_cpl, & 37 38 ln_medusa 38 39 USE albedo ! … … 145 146 INTEGER, PARAMETER :: jps_sstfrz = 32 ! sea-surface freezing temperature 146 147 INTEGER, PARAMETER :: jps_fice1 = 33 ! first-order ice concentration (for time-travelling ice coupling) 147 INTEGER, PARAMETER :: jps_bio_co2 = 34 ! MEDUSA air-sea CO2 flux in 148 INTEGER, PARAMETER :: jps_bio_dms = 35 ! MEDUSA DMS surface concentration in 149 INTEGER, PARAMETER :: jpsnd = 35 ! total number of fields sent 148 INTEGER, PARAMETER :: jps_bio_co2 = 34 ! MEDUSA air-sea CO2 flux 149 INTEGER, PARAMETER :: jps_bio_dms = 35 ! MEDUSA DMS surface concentration 150 INTEGER, PARAMETER :: jps_bio_chloro = 36 ! MEDUSA chlorophyll surface concentration 151 INTEGER, PARAMETER :: jpsnd = 36 ! total number of fields sent 150 152 151 153 REAL(wp), PARAMETER :: dms_unit_conv = 1.0e+6 ! Coversion factor to get outgong DMS in standard units for coupling … … 162 164 ! Send to the atmosphere ! 163 165 TYPE(FLD_C) :: sn_snd_temp, sn_snd_alb, sn_snd_thick, sn_snd_crt, sn_snd_co2, sn_snd_cond, sn_snd_mpnd, sn_snd_sstfrz, sn_snd_thick1 164 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms 166 TYPE(FLD_C) :: sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro 165 167 166 168 ! Received from the atmosphere ! … … 207 209 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 208 210 #endif 209 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 211 !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 212 ! Hardwire only two models as nn_cplmodel has not been read in 213 ! from the namelist yet. 214 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 210 215 ! 211 216 sbc_cpl_alloc = MAXVAL( ierr ) … … 246 251 247 252 ! Add MEDUSA related fields to namelist 248 NAMELIST/namsbc_cpl/ sn_snd_bio_co2, sn_snd_bio_dms, 253 NAMELIST/namsbc_cpl/ sn_snd_bio_co2, sn_snd_bio_dms, sn_snd_bio_chloro, & 249 254 & sn_rcv_atm_pco2, sn_rcv_atm_dust 250 255 … … 304 309 WRITE(numout,*)' bio co2 flux = ', TRIM(sn_snd_bio_co2%cldes), ' (', TRIM(sn_snd_bio_co2%clcat), ')' 305 310 WRITE(numout,*)' bio dms flux = ', TRIM(sn_snd_bio_dms%cldes), ' (', TRIM(sn_snd_bio_dms%clcat), ')' 311 WRITE(numout,*)' bio dms chlorophyll = ', TRIM(sn_snd_bio_chloro%cldes), ' (', TRIM(sn_snd_bio_chloro%clcat), ')' 306 312 WRITE(numout,*)' oce co2 flux = ', TRIM(sn_snd_co2%cldes ), ' (', TRIM(sn_snd_co2%clcat ), ')' 307 313 WRITE(numout,*)' ice effective conductivity = ', TRIM(sn_snd_cond%cldes ), ' (', TRIM(sn_snd_cond%clcat ), ')' … … 321 327 322 328 ! ! allocate sbccpl arrays 323 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )329 !IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 324 330 325 331 ! ================================ ! … … 384 390 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 385 391 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 386 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 392 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 393 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 394 srcv(jpr_otx1)%laction = .TRUE. 395 srcv(jpr_oty1)%laction = .TRUE. 396 ! 387 397 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 388 398 CASE( 'T,I' ) … … 826 836 IF( TRIM(sn_snd_bio_co2%cldes) == 'medusa' ) ssnd(jps_bio_co2 )%laction = .TRUE. 827 837 838 ! Surface chlorophyll from Medusa 839 ssnd(jps_bio_chloro)%clname = 'OBioChlo' 840 IF( TRIM(sn_snd_bio_chloro%cldes) == 'medusa' ) ssnd(jps_bio_chloro )%laction = .TRUE. 841 828 842 ! ! ------------------------- ! 829 843 ! ! Sea surface freezing temp ! … … 1035 1049 INTEGER :: ji, jj, jl, jn ! dummy loop indices 1036 1050 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1051 INTEGER :: ikchoix 1037 1052 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1038 1053 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in … … 1043 1058 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1044 1059 REAL(wp) :: zzx, zzy ! temporary variables 1045 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 1060 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 1046 1061 !!---------------------------------------------------------------------- 1047 1062 1048 ! RSRH temporary arrays for testing, just to recieve incoming MEDUSA related fields1049 ! until we know where they need to go.1050 REAL(wp), ALLOCATABLE :: atm_pco2(:,:)1051 REAL(wp), ALLOCATABLE :: atm_dust(:,:)1052 1053 1063 ! 1054 1064 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 1055 1065 ! 1056 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1066 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1057 1067 ! 1058 1068 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1092 1102 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1093 1103 ! ! (geographical to local grid -> rotate the components) 1094 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1095 IF( srcv(jpr_otx2)%laction ) THEN 1096 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1097 ELSE 1098 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1104 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1105 ! Temporary code for HadGEM3 - will be removed eventually. 1106 ! Only applies when we have only taux on U grid and tauy on V grid 1107 DO jj=2,jpjm1 1108 DO ji=2,jpim1 1109 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1110 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1111 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1112 zty(ji,jj)=0.25*umask(ji,jj,1) & 1113 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1114 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1115 ENDDO 1116 ENDDO 1117 1118 ikchoix = 1 1119 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1120 CALL lbc_lnk (ztx2,'U', -1. ) 1121 CALL lbc_lnk (zty2,'V', -1. ) 1122 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1123 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1124 ELSE 1125 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1126 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1127 IF( srcv(jpr_otx2)%laction ) THEN 1128 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1129 ELSE 1130 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1131 ENDIF 1132 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1099 1133 ENDIF 1100 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1101 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1102 1134 ENDIF 1103 1135 ! … … 1419 1451 1420 1452 ! 1421 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1453 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1422 1454 ! 1423 1455 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 2101 2133 ! 2102 2134 INTEGER :: ji, jj, jl ! dummy loop indices 2135 INTEGER :: ikchoix 2103 2136 INTEGER :: isec, info ! local integer 2104 2137 REAL(wp) :: zumax, zvmax … … 2347 2380 2348 2381 IF (ln_medusa) THEN 2349 ! ! --------------------------------- !2350 ! ! CO2 flux and DMSfrom MEDUSA !2351 ! ! --------------------------------- !2382 ! ! ---------------------------------------------- ! 2383 ! ! CO2 flux, DMS and chlorophyll from MEDUSA ! 2384 ! ! ---------------------------------------------- ! 2352 2385 IF ( ssnd(jps_bio_co2)%laction ) THEN 2353 2386 CALL cpl_snd( jps_bio_co2, isec, RESHAPE( CO2Flux_out_cpl, (/jpi,jpj,1/) ), info ) … … 2356 2389 IF ( ssnd(jps_bio_dms)%laction ) THEN 2357 2390 CALL cpl_snd( jps_bio_dms, isec, RESHAPE( DMS_out_cpl, (/jpi,jpj,1/) ), info ) 2391 ENDIF 2392 2393 IF ( ssnd(jps_bio_chloro)%laction ) THEN 2394 CALL cpl_snd( jps_bio_chloro, isec, RESHAPE( chloro_out_cpl, (/jpi,jpj,1/) ), info ) 2358 2395 ENDIF 2359 2396 ENDIF … … 2365 2402 ! j+1 j -----V---F 2366 2403 ! surface velocity always sent from T point ! | 2367 ! 2404 ! [except for HadGEM3] j | T U 2368 2405 ! | | 2369 2406 ! j j-1 -I-------| … … 2377 2414 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2378 2415 CASE( 'oce only' ) ! C-grid ==> T 2379 DO jj = 2, jpjm1 2380 DO ji = fs_2, fs_jpim1 ! vector opt. 2381 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2382 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2416 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2417 DO jj = 2, jpjm1 2418 DO ji = fs_2, fs_jpim1 ! vector opt. 2419 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2420 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2421 END DO 2383 2422 END DO 2384 END DO 2423 ELSE 2424 ! Temporarily Changed for UKV 2425 DO jj = 2, jpjm1 2426 DO ji = 2, jpim1 2427 zotx1(ji,jj) = un(ji,jj,1) 2428 zoty1(ji,jj) = vn(ji,jj,1) 2429 END DO 2430 END DO 2431 ENDIF 2385 2432 CASE( 'weighted oce and ice' ) 2386 2433 SELECT CASE ( cp_ice_msh ) … … 2441 2488 END DO 2442 2489 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2443 DO jj = 2, jpjm1 2444 DO ji = 2, jpim1 ! NO vector opt. 2445 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2446 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2447 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2448 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2449 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2450 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2490 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2491 DO jj = 2, jpjm1 2492 DO ji = 2, jpim1 ! NO vector opt. 2493 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 2494 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2495 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2496 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 2497 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2498 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2499 END DO 2451 2500 END DO 2452 END DO 2501 #if defined key_cice 2502 ELSE 2503 ! Temporarily Changed for HadGEM3 2504 DO jj = 2, jpjm1 2505 DO ji = 2, jpim1 ! NO vector opt. 2506 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 2507 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 2508 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 2509 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 2510 END DO 2511 END DO 2512 #endif 2513 ENDIF 2453 2514 END SELECT 2454 2515 END SELECT … … 2460 2521 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2461 2522 ! ! Ocean component 2462 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2463 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2464 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2465 zoty1(:,:) = ztmp2(:,:) 2466 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2467 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2468 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2469 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2470 zity1(:,:) = ztmp2(:,:) 2471 ENDIF 2523 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2524 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2525 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2526 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2527 zoty1(:,:) = ztmp2(:,:) 2528 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2529 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2530 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2531 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2532 zity1(:,:) = ztmp2(:,:) 2533 ENDIF 2534 ELSE 2535 ! Temporary code for HadGEM3 - will be removed eventually. 2536 ! Only applies when we want uvel on U grid and vvel on V grid 2537 ! Rotate U and V onto geographic grid before sending. 2538 2539 DO jj=2,jpjm1 2540 DO ji=2,jpim1 2541 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2542 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2543 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2544 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2545 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2546 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2547 ENDDO 2548 ENDDO 2549 2550 ! Ensure any N fold and wrap columns are updated 2551 CALL lbc_lnk(ztmp1, 'V', -1.0) 2552 CALL lbc_lnk(ztmp2, 'U', -1.0) 2553 2554 ikchoix = -1 2555 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2556 ENDIF 2472 2557 ENDIF 2473 2558 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r6500 r8280 302 302 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 303 303 ! 304 ! In coupled mode get extra fields from CICE for passing back to atmosphere 305 306 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 307 ! 304 308 IF( nn_timing == 1 ) CALL timing_stop('cice_sbc_init') 305 309 ! … … 736 740 IF( nn_timing == 1 ) CALL timing_start('cice_sbc_hadgam') 737 741 ! 738 IF( kt == nit000 ) THEN739 IF(lwp) WRITE(numout,*)'cice_sbc_hadgam'740 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )741 ENDIF742 743 742 ! ! =========================== ! 744 743 ! ! Prepare Coupling fields ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r7993 r8280 266 266 ENDIF 267 267 ! 268 IF( lk_oasis ) CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 269 ! ! (2) the use of nn_fsbc 268 IF( lk_oasis ) THEN 269 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 270 CALL sbc_cpl_init (nn_ice) ! OASIS initialisation. must be done before: (1) first time step 271 ! (2) the use of nn_fsbc 272 ENDIF 270 273 271 274 ! nn_fsbc initialization if OPA-SAS coupling via OASIS -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r7179 r8280 327 327 END DO 328 328 ELSE 329 IF(lwp)WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht330 IF(lwp)WRITE(numout,*) ' We stop'331 STOP 'ldfght'329 WRITE(numout,*) ' ldfght: kaht= 1 or 2, here =', kaht 330 WRITE(numout,*) ' We stop' 331 CALL ctl_stop( 'STOP', 'ldfght : unexpected kaht value') 332 332 ENDIF 333 333 ! ! =============== -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRD/trdtrc.F90
r6486 r8280 1 #if ! defined key_top 1 2 MODULE trdtrc 2 3 !!====================================================================== … … 22 23 !!====================================================================== 23 24 END MODULE trdtrc 25 #endif -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r7563 r8280 68 68 USE icbini ! handle bergs, initialisation 69 69 USE icbstp ! handle bergs, calving, themodynamics and transport 70 USE sbccpl 70 71 USE cpl_oasis3 ! OASIS3 coupling 71 72 USE c1d ! 1D configuration … … 74 75 #if defined key_top 75 76 USE trcini ! passive tracer initialisation 77 USE trc, ONLY: numstr ! tracer stats unit number 76 78 #endif 77 79 USE lib_mpp ! distributed memory computing … … 169 171 CALL stp ! AGRIF: time stepping 170 172 #else 171 CALL stp( istp ) ! standard time stepping 173 IF (lk_oasis) CALL sbc_cpl_snd( istp ) ! Coupling to atmos 174 CALL stp( istp ) 175 ! We don't couple on the final timestep because 176 ! our restart file has already been written 177 ! and contains all the necessary data for a 178 ! restart. sbc_cpl_snd could be called here 179 ! but it would require 180 ! a) A test to ensure it was not performed 181 ! on the very last time-step 182 ! b) the presence of another call to 183 ! sbc_cpl_snd call prior to the main DO loop 184 ! This solution produces identical results 185 ! with fewer lines of code. 172 186 #endif 173 187 istp = istp + 1 … … 283 297 IF( Agrif_Root() ) THEN 284 298 IF( lk_oasis ) THEN 285 CALL cpl_init( " oceanx", ilocal_comm ) ! nemo local communicator given by oasis299 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 286 300 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 287 301 ELSE … … 294 308 IF( lk_oasis ) THEN 295 309 IF( Agrif_Root() ) THEN 296 CALL cpl_init( " oceanx", ilocal_comm ) ! nemo local communicator given by oasis310 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 297 311 ENDIF 298 312 ! Nodes selection (control print return in cltxt) … … 474 488 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 475 489 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 490 491 IF (nstop > 0) THEN 492 CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 493 END IF 494 476 495 ! 477 496 END SUBROUTINE nemo_init … … 609 628 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 610 629 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 611 630 #if defined key_top 631 IF( numstr /= -1 ) CLOSE( numstr ) ! tracer statistics 632 #endif 612 633 ! 613 634 numout = 6 ! redefine numout in case it is used after this point... -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/oce.F90
r7770 r8280 77 77 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: CO2Flux_out_cpl(:,:) ! Output coupling CO2 flux 78 78 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: DMS_out_cpl(:,:) ! Output coupling DMS 79 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: chloro_out_cpl(:,:) ! Output coupling chlorophyll 80 ! (expected in Kg/M3) 79 81 80 82 REAL(wp), PUBLIC, ALLOCATABLE, SAVE :: PCO2a_in_cpl(:,:) ! Input coupling CO2 partial pressure … … 138 140 ! are enabled 139 141 ALLOCATE( CO2Flux_out_cpl(jpi,jpj), DMS_out_cpl(jpi,jpj), & 142 chloro_out_cpl(jpi,jpj), & 140 143 PCO2a_in_cpl(jpi,jpj), Dust_in_cpl(jpi,jpj), STAT=ierr(5) ) 141 144 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/step.F90
r7962 r8280 380 380 ! Coupled mode 381 381 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 382 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges382 !IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 383 383 ! 384 384 #if defined key_iomput -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90
r6486 r8280 453 453 SUBROUTINE wrk_allocbase( kidim , kjdim , kkdim , kldim , kisrt , kjsrt , kksrt , klsrt , & 454 454 & kwrk1d, kwrk2d, kwrk3d, kwrk4d, pwrk1d, pwrk2d, pwrk3d, pwrk4d ) 455 USE in_out_manager, ONLY: numout 455 456 INTEGER , INTENT(in ) :: kidim, kjdim, kkdim, kldim 456 457 INTEGER , INTENT(in ) :: kisrt, kjsrt, kksrt, klsrt … … 483 484 & .AND. SUM( tree(ii)%ishape ) /= 0 ) 484 485 ii = ii + 1 485 IF (ii > jparray) STOP ! increase the value of jparray (should not be needed as already very big!) 486 IF (ii > jparray) THEN 487 WRITE(numout,*) "E R R O R: NEMO aborted wrk_allocbase" 488 FLUSH(numout) 489 STOP 'Increase the value of jparray' 490 ! increase the value of jparray (should not be needed as already very big!) 491 END IF 486 492 END DO 487 493 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/C14b/par_c14b.F90
r6486 r8280 11 11 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES 12 12 13 USE par_medusa , ONLY : jp_medusa !: number of tracers in MEDUSA 14 USE par_medusa , ONLY : jp_medusa_2d !: number of 2D diag in MEDUSA 15 USE par_medusa , ONLY : jp_medusa_3d !: number of 3D diag in MEDUSA 16 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 17 18 USE par_idtra , ONLY : jp_idtra !: number of tracers in MEDUSA 19 USE par_idtra , ONLY : jp_idtra_2d !: number of tracers in MEDUSA 20 USE par_idtra , ONLY : jp_idtra_3d !: number of tracers in MEDUSA 21 USE par_idtra , ONLY : jp_idtra_trd !: number of tracers in MEDUSA 22 13 23 USE par_cfc , ONLY : jp_cfc !: number of tracers in CFC 14 24 USE par_cfc , ONLY : jp_cfc_2d !: number of 2D diag in CFC … … 19 29 IMPLICIT NONE 20 30 21 INTEGER, PARAMETER :: jp_lb = jp_pisces + jp_cfc !: cum. number of pass. tracers 22 INTEGER, PARAMETER :: jp_lb_2d = jp_pisces_2d + jp_cfc_2d !: 23 INTEGER, PARAMETER :: jp_lb_3d = jp_pisces_3d + jp_cfc_3d !: 24 INTEGER, PARAMETER :: jp_lb_trd = jp_pisces_trd + jp_cfc_trd !: 31 INTEGER, PARAMETER :: jp_lb = jp_pisces + jp_medusa + & 32 jp_idtra + jp_cfc !: cum. number of pass. tracers 33 INTEGER, PARAMETER :: jp_lb_2d = jp_pisces_2d + jp_medusa_2d + & 34 jp_idtra_2d + jp_cfc_2d !: 35 INTEGER, PARAMETER :: jp_lb_3d = jp_pisces_3d + jp_medusa_3d + & 36 jp_idtra_3d + jp_cfc_3d !: 37 INTEGER, PARAMETER :: jp_lb_trd = jp_pisces_trd + jp_medusa_trd + & 38 jp_idtra_trd + jp_cfc_trd !: 25 39 26 40 #if defined key_c14b -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90
r6486 r8280 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 7 !! ! 2017-04 (A. Yool) add SF6 7 8 !!---------------------------------------------------------------------- 8 9 !! NEMO/TOP 3.3 , NEMO Consortium (2010) … … 15 16 USE par_pisces , ONLY : jp_pisces_trd !: number of biological diag in PISCES 16 17 18 USE par_medusa , ONLY : jp_medusa !: number of tracers in MEDUSA 19 USE par_medusa , ONLY : jp_medusa_2d !: number of 2D diag in MEDUSA 20 USE par_medusa , ONLY : jp_medusa_3d !: number of 3D diag in MEDUSA 21 USE par_medusa , ONLY : jp_medusa_trd !: number of biological diag in MEDUSA 22 23 USE par_idtra , ONLY : jp_idtra !: number of tracers in ideal tracer 24 USE par_idtra , ONLY : jp_idtra_2d !: number of tracers in ideal tracer 25 USE par_idtra , ONLY : jp_idtra_3d !: number of tracers in ideal tracer 26 USE par_idtra , ONLY : jp_idtra_trd !: number of tracers in ideal tracer 27 17 28 IMPLICIT NONE 18 29 19 INTEGER, PARAMETER :: jp_lc = jp_pisces !: cumulative number of passive tracers 20 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d !: 21 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d !: 22 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd !: 30 INTEGER, PARAMETER :: jp_lc = jp_pisces + jp_medusa + & 31 jp_idtra !: cumulative number of passive tracers 32 INTEGER, PARAMETER :: jp_lc_2d = jp_pisces_2d + jp_medusa_2d + & 33 jp_idtra_2d !: 34 INTEGER, PARAMETER :: jp_lc_3d = jp_pisces_3d + jp_medusa_3d + & 35 jp_idtra_3d !: 36 INTEGER, PARAMETER :: jp_lc_trd = jp_pisces_trd + jp_medusa_trd + & 37 jp_idtra_trd !: 23 38 24 39 #if defined key_cfc … … 27 42 !!--------------------------------------------------------------------- 28 43 LOGICAL, PUBLIC, PARAMETER :: lk_cfc = .TRUE. !: CFC flag 29 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 1!: number of passive tracers30 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 2!: additional 2d output arrays ('key_trc_diaadd')44 INTEGER, PUBLIC, PARAMETER :: jp_cfc = 3 !: number of passive tracers 45 INTEGER, PUBLIC, PARAMETER :: jp_cfc_2d = 6 !: additional 2d output arrays ('key_trc_diaadd') 31 46 INTEGER, PUBLIC, PARAMETER :: jp_cfc_3d = 0 !: additional 3d output arrays ('key_trc_diaadd') 32 47 INTEGER, PUBLIC, PARAMETER :: jp_cfc_trd = 0 !: number of sms trends for CFC … … 34 49 ! assign an index in trc arrays for each CFC prognostic variables 35 50 INTEGER, PUBLIC, PARAMETER :: jpc11 = jp_lc + 1 !: CFC-11 36 INTEGER, PUBLIC, PARAMETER :: jpc12 = jp_lc + 2 !: CFC-12 51 INTEGER, PUBLIC, PARAMETER :: jpc12 = jp_lc + 2 !: CFC-12 (priority tracer for CMIP6) 52 INTEGER, PUBLIC, PARAMETER :: jpsf6 = jp_lc + 3 !: SF6 37 53 #else 38 54 !!--------------------------------------------------------------------- … … 47 63 48 64 ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 49 INTEGER, PUBLIC, PARAMETER :: jp_cfc0 = jp_lc + 1 !: First index of CFC tracers50 INTEGER, PUBLIC, PARAMETER :: jp_cfc1 = jp_lc + jp_cfc !: Last index of CFC tracers51 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_2d = jp_lc_2d + 1 !: First index of CFC tracers65 INTEGER, PUBLIC, PARAMETER :: jp_cfc0 = jp_lc + 1 !: First index of CFC tracers 66 INTEGER, PUBLIC, PARAMETER :: jp_cfc1 = jp_lc + jp_cfc !: Last index of CFC tracers 67 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_2d = jp_lc_2d + 1 !: First index of CFC tracers 52 68 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_2d = jp_lc_2d + jp_cfc_2d !: Last index of CFC tracers 53 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_3d = jp_lc_3d + 1 !: First index of CFC tracers69 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_3d = jp_lc_3d + 1 !: First index of CFC tracers 54 70 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_3d = jp_lc_3d + jp_cfc_3d !: Last index of CFC tracers 55 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_trd = jp_lc_trd + 1 !: First index of CFC tracers56 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_trd = jp_lc_trd + jp_cfc_trd 71 INTEGER, PUBLIC, PARAMETER :: jp_cfc0_trd = jp_lc_trd + 1 !: First index of CFC tracers 72 INTEGER, PUBLIC, PARAMETER :: jp_cfc1_trd = jp_lc_trd + jp_cfc_trd !: Last index of CFC tracers 57 73 58 74 !!====================================================================== -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90
r6486 r8280 5 5 !!====================================================================== 6 6 !! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) 7 !! ! 2017-04 (A. Yool) Add SF6 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_cfc … … 22 23 PUBLIC trc_ini_cfc ! called by trcini.F90 module 23 24 24 CHARACTER (len=34) :: clname = 'cfc1112 .atm' ! ???25 CHARACTER (len=34) :: clname = 'cfc1112sf6.atm' ! ??? 25 26 26 27 INTEGER :: inum ! unit number … … 44 45 !!---------------------------------------------------------------------- 45 46 INTEGER :: ji, jj, jn, jl, jm, js, io, ierr 46 INTEGER :: iskip = 6! number of 1st descriptor lines47 INTEGER :: iskip = 7 ! number of 1st descriptor lines 47 48 REAL(wp) :: zyy, zyd 48 49 !!---------------------------------------------------------------------- … … 53 54 54 55 55 IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112 atm'56 IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112sf6.atm' 56 57 57 58 CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) … … 69 70 ! ! Allocate CFC arrays 70 71 71 ALLOCATE( p_cfc(jpyear,jphem, 2), STAT=ierr )72 ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 72 73 IF( ierr > 0 ) THEN 73 74 CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' ) ; RETURN … … 90 91 ENDIF 91 92 qint_cfc(:,:,:) = 0._wp 92 DO jl = 1, jp_cfc 93 jn = jp_cfc0 + jl - 1 94 trn(:,:,:,jn) = 0._wp 95 END DO 93 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 96 94 ENDIF 97 95 … … 105 103 jn = 31 106 104 DO 107 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 105 READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), & 106 & p_cfc(jn,1,3), p_cfc(jn,2,1), & 107 & p_cfc(jn,2,2), p_cfc(jn,2,3) 108 108 IF( io < 0 ) exit 109 109 jn = jn + 1 110 110 END DO 111 111 112 p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 113 p_cfc(33,1:2,1) = 8.e-4 114 p_cfc(34,1:2,1) = 1.e-6 115 p_cfc(35,1:2,1) = 2.e-3 116 p_cfc(36,1:2,1) = 4.e-3 117 p_cfc(37,1:2,1) = 6.e-3 118 p_cfc(38,1:2,1) = 8.e-3 119 p_cfc(39,1:2,1) = 1.e-2 112 ! AXY (25/04/17): do not adjust 113 ! p_cfc(32,1:2,1) = 5.e-4 ! modify the values of the first years 114 ! p_cfc(33,1:2,1) = 8.e-4 115 ! p_cfc(34,1:2,1) = 1.e-6 116 ! p_cfc(35,1:2,1) = 2.e-3 117 ! p_cfc(36,1:2,1) = 4.e-3 118 ! p_cfc(37,1:2,1) = 6.e-3 119 ! p_cfc(38,1:2,1) = 8.e-3 120 ! p_cfc(39,1:2,1) = 1.e-2 120 121 121 122 IF(lwp) THEN ! Control print 122 123 WRITE(numout,*) 123 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS '124 WRITE(numout,*) ' Year p11HN p11HS p12HN p12HS pSF6N pSF6S ' 124 125 DO jn = 30, jpyear 125 WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 126 WRITE(numout, '( 1I4, 6F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), & 127 & p_cfc(jn,1,2), p_cfc(jn,2,2), & 128 & p_cfc(jn,1,3), p_cfc(jn,2,3) 126 129 END DO 127 130 ENDIF 128 129 131 130 132 ! Interpolation factor of atmospheric partial pressure -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r6486 r8280 49 49 TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 50 50 !! 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res 51 NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type 52 52 NAMELIST/namcfcdia/ cfcdia2d ! additional diagnostics 53 53 !!---------------------------------------------------------------------- … … 72 72 WRITE(numout,*) ' initial calendar date (aammjj) for CFC ndate_beg = ', ndate_beg 73 73 WRITE(numout,*) ' restoring time constant (year) nyear_res = ', nyear_res 74 IF (simu_type==1) THEN 75 WRITE(numout,*) ' CFC running on SPIN-UP mode simu_type = ', simu_type 76 ELSEIF (simu_type==2) THEN 77 WRITE(numout,*) ' CFC running on HINDCAST/PROJECTION mode simu_type = ', simu_type 78 ENDIF 74 79 ENDIF 75 80 nyear_beg = ndate_beg / 10000 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r6486 r8280 7 7 !! NEMO 1.0 ! 2004-03 (C. Ethe) free form + modularity 8 8 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) reorganisation 9 !! ! 2016-06 (J. Palmieri) update for UKESM1 10 !! ! 2017-04 (A. Yool) update to add SF6, fix coefficients 9 11 !!---------------------------------------------------------------------- 10 12 #if defined key_cfc … … 15 17 !! cfc_init : sets constants for CFC surface forcing computation 16 18 !!---------------------------------------------------------------------- 19 USE dom_oce ! ocean space and time domain 17 20 USE oce_trc ! Ocean variables 18 21 USE par_trc ! TOP parameters … … 31 34 INTEGER , PUBLIC :: jpyear ! Number of years read in CFC1112 file 32 35 INTEGER , PUBLIC :: ndate_beg ! initial calendar date (aammjj) for CFC 36 INTEGER , PUBLIC :: simu_type ! Kind of simulation: 1- Spin-up 37 ! 2- Hindcast/projection 33 38 INTEGER , PUBLIC :: nyear_res ! restoring time constant (year) 34 39 INTEGER , PUBLIC :: nyear_beg ! initial year (aa) … … 40 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric function 41 46 42 REAL(wp), DIMENSION(4, 2) :: soa ! coefficient for solubility of CFC [mol/l/atm]43 REAL(wp), DIMENSION(3, 2) :: sob ! " "44 REAL(wp), DIMENSION( 4,2) :: sca ! coefficients for schmidt number in degre Celcius47 REAL(wp), DIMENSION(4,3) :: soa ! coefficient for solubility of CFC [mol/l/atm] 48 REAL(wp), DIMENSION(3,3) :: sob ! " " 49 REAL(wp), DIMENSION(5,3) :: sca ! coefficients for schmidt number in degre Celcius 45 50 46 51 ! ! coefficients for conversion … … 79 84 ! 80 85 INTEGER :: ji, jj, jn, jl, jm, js 81 INTEGER :: iyear_beg, iyear_end 86 INTEGER :: iyear_beg, iyear_end, iyear_tmp 82 87 INTEGER :: im1, im2, ierr 83 88 REAL(wp) :: ztap, zdtap 84 REAL(wp) :: zt1, zt2, zt3, z v289 REAL(wp) :: zt1, zt2, zt3, zt4, zv2 85 90 REAL(wp) :: zsol ! solubility 86 91 REAL(wp) :: zsch ! schmidt number … … 103 108 ! Temporal interpolation 104 109 ! ---------------------- 105 iyear_beg = nyear - 1900 110 !! JPALM -- 15-06-2016 -- define 2 kinds of CFC run: 111 !! 1- the SPIN-UP and 2- Hindcast/Projections 112 !! -- main difference is the way to define the year of 113 !! simulation, that determine the atm pCFC. 114 !! 1-- Spin-up: our atm forcing is of 30y we cycle on. 115 !! So we do 90y CFC cycles to be in good 116 !! correspondence with the atmosphere 117 !! 2-- Hindcast/proj, instead of nyear-1900 we keep 118 !! the 2 last digit, and enable 3 cycle from 1800 to 2100. 119 !!---------------------------------------------------------------------- 120 IF (simu_type==1) THEN 121 !! 1 -- SPIN-UP 122 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 123 iyear_beg = MOD( iyear_tmp , 90 ) 124 !! JPALM -- the pCFC file only got 78 years. 125 !! So if iyear_beg > 78 then we set pCFC to 0 126 !! iyear_beg = 0 as well -- must try to avoid obvious problems 127 !! as Pcfc is set to 0.00 up to year 32, let set iyear_beg to year 10 128 !! else, must add 30 to iyear_beg to match with P_cfc indices 129 !!--------------------------------------- 130 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 131 iyear_beg = 10 132 ELSE 133 iyear_beg = iyear_beg + 30 134 ENDIF 135 ELSEIF (simu_type==2) THEN 136 !! 2 -- Hindcast/proj 137 iyear_beg = MOD(nyear, 100) 138 IF (iyear_beg < 20) iyear_beg = iyear_beg + 100 139 !! JPALM -- Same than previously, if iyear_beg is out of P_cfc range, 140 !! we want to set p_CFC to 0.00 --> set iyear_beg = 10 141 IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) iyear_beg = 10 142 ENDIF 143 !! 106 144 IF ( nmonth <= 6 ) THEN 107 145 iyear_beg = iyear_beg - 1 … … 152 190 zt2 = zt1 * zt1 153 191 zt3 = zt1 * zt2 154 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 192 zt4 = zt1 * zt3 193 zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 155 194 156 195 ! speed transfert : formulae of wanninkhof 1992 157 196 zv2 = wndm(ji,jj) * wndm(ji,jj) 158 197 zsch = zsch / 660. 159 zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 198 ! AXY (25/04/17): OMIP protocol specifies lower Wanninkhof (2014) value 199 ! zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 200 zak_cfc = ( 0.251 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 160 201 161 202 ! Input function : speed *( conc. at equil - concen at surface ) … … 176 217 ! !----------------! 177 218 END DO ! end CFC loop ! 178 ! 179 IF( lrst_trc ) THEN 180 IF(lwp) WRITE(numout,*) 181 IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 182 & 'at it= ', kt,' date= ', ndastp 183 IF(lwp) WRITE(numout,*) '~~~~' 184 DO jn = jp_cfc0, jp_cfc1 185 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 186 END DO 187 ENDIF 219 ! 220 IF( kt == nittrc000 ) THEN 221 DO jl = 1, jp_cfc 222 WRITE(NUMOUT,*) ' ' 223 WRITE(NUMOUT,*) 'CFC interpolation verification ' !! Jpalm 224 WRITE(NUMOUT,*) '################################## ' 225 WRITE(NUMOUT,*) ' ' 226 if (jl.EQ.1) then 227 WRITE(NUMOUT,*) 'Traceur = CFC11: ' 228 elseif (jl.EQ.2) then 229 WRITE(NUMOUT,*) 'Traceur = CFC12: ' 230 elseif (jl.EQ.3) then 231 WRITE(NUMOUT,*) 'Traceur = SF6: ' 232 endif 233 WRITE(NUMOUT,*) 'nyear = ', nyear 234 WRITE(NUMOUT,*) 'nmonth = ', nmonth 235 WRITE(NUMOUT,*) 'iyear_beg= ', iyear_beg 236 WRITE(NUMOUT,*) 'iyear_end= ', iyear_end 237 WRITE(NUMOUT,*) 'p_cfc(iyear_beg)= ',p_cfc(iyear_beg, 1, jl) 238 WRITE(NUMOUT,*) 'p_cfc(iyear_end)= ',p_cfc(iyear_end, 1, jl) 239 WRITE(NUMOUT,*) 'Im1= ',im1 240 WRITE(NUMOUT,*) 'Im2= ',im2 241 WRITE(NUMOUT,*) 'zpp_cfc = ',zpp_cfc 242 WRITE(NUMOUT,*) ' ' 243 END DO 244 # if defined key_debug_medusa 245 CALL flush(numout) 246 # endif 247 ENDIF 248 ! 249 !IF( lrst_trc ) THEN 250 ! IF(lwp) WRITE(numout,*) 251 ! IF(lwp) WRITE(numout,*) 'trc_sms_cfc : cumulated input function fields written in ocean restart file ', & 252 ! & 'at it= ', kt,' date= ', ndastp 253 ! IF(lwp) WRITE(numout,*) '~~~~' 254 ! DO jn = jp_cfc0, jp_cfc1 255 ! CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 256 ! END DO 257 !ENDIF 188 258 ! 189 259 IF( lk_iomput ) THEN 190 CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 191 CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 260 IF (iom_use("qtrCFC11")) CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 261 IF (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 262 IF (iom_use("qtrCFC12")) CALL iom_put( "qtrCFC12" , qtr_cfc (:,:,2) ) 263 IF (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 264 IF (iom_use("qtrSF6")) CALL iom_put( "qtrSF6" , qtr_cfc (:,:,3) ) 265 IF (iom_use("qintSF6")) CALL iom_put( "qintSF6" , qint_cfc(:,:,3) ) 192 266 ELSE 193 267 IF( ln_diatrc ) THEN 194 268 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 195 269 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 270 trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 271 trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 272 trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 273 trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 196 274 END IF 197 275 END IF … … 203 281 END IF 204 282 ! 283 # if defined key_debug_medusa 284 IF(lwp) WRITE(numout,*) ' CFC - Check: nn_timing = ', nn_timing 285 CALL flush(numout) 286 # endif 205 287 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_cfc') 206 288 ! … … 214 296 !! ** Purpose : sets constants for CFC model 215 297 !!--------------------------------------------------------------------- 216 INTEGER :: j n298 INTEGER :: jl, jn, iyear_beg, iyear_tmp 217 299 218 300 ! coefficient for CFC11 … … 223 305 soa(2,1) = 319.6552 224 306 soa(3,1) = 119.4471 225 soa(4,1) = -1.39165 226 227 sob(1,1) = -0.142382 228 sob(2,1) = 0.091459 229 sob(3,1) = -0.0157274 230 231 ! Schmidt number 232 sca(1,1) = 3501.8 233 sca(2,1) = -210.31 234 sca(3,1) = 6.1851 235 sca(4,1) = -0.07513 307 soa(4,1) = -1.39165 308 309 sob(1,1) = -0.142382 310 sob(2,1) = 0.091459 311 sob(3,1) = -0.0157274 312 313 ! Schmidt number AXY (25/04/17) 314 sca(1,1) = 3579.2 ! = 3501.8 315 sca(2,1) = -222.63 ! = -210.31 316 sca(3,1) = 7.5749 ! = 6.1851 317 sca(4,1) = -0.14595 ! = -0.07513 318 sca(5,1) = 0.0011874 ! = absent 236 319 237 320 ! coefficient for CFC12 … … 242 325 soa(2,2) = 298.9702 243 326 soa(3,2) = 113.8049 244 soa(4,2) = -1.39165 245 246 sob(1,2) = -0.143566 247 sob(2,2) = 0.091015 248 sob(3,2) = -0.0153924 249 250 ! schmidt number 251 sca(1,2) = 3845.4 252 sca(2,2) = -228.95 253 sca(3,2) = 6.1908 254 sca(4,2) = -0.067430 255 256 IF( ln_rsttr ) THEN 257 IF(lwp) WRITE(numout,*) 258 IF(lwp) WRITE(numout,*) ' Read specific variables from CFC model ' 259 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 260 ! 261 DO jn = jp_cfc0, jp_cfc1 262 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 263 END DO 327 soa(4,2) = -1.39165 328 329 sob(1,2) = -0.143566 330 sob(2,2) = 0.091015 331 sob(3,2) = -0.0153924 332 333 ! schmidt number AXY (25/04/17) 334 sca(1,2) = 3828.1 ! = 3845.4 335 sca(2,2) = -249.86 ! = -228.95 336 sca(3,2) = 8.7603 ! = 6.1908 337 sca(4,2) = -0.1716 ! = -0.067430 338 sca(5,2) = 0.001408 ! = absent 339 340 ! coefficients for SF6 AXY (25/04/17) 341 !--------------------- 342 343 ! Solubility 344 soa(1,3) = -80.0343 345 soa(2,3) = 117.232 346 soa(3,3) = 29.5817 347 soa(4,3) = 0.0 348 349 sob(1,3) = 0.0335183 350 sob(2,3) = -0.0373942 351 sob(3,3) = 0.00774862 352 353 ! Schmidt number 354 sca(1,3) = 3177.5 355 sca(2,3) = -200.57 356 sca(3,3) = 6.8865 357 sca(4,3) = -0.13335 358 sca(5,3) = 0.0010877 359 360 !!--------------------------------------------- 361 !! JPALM -- re-initialize CFC fields and diags if restart a CFC cycle, 362 !! Or if out of P_cfc range 363 IF (simu_type==1) THEN 364 iyear_tmp = nyear - nyear_res !! JPALM -- in our spin-up, nyear_res is 1000 365 iyear_beg = MOD( iyear_tmp , 90 ) 366 !!--------------------------------------- 367 IF ((iyear_beg > 77) .OR. (iyear_beg==0)) THEN 368 qtr_cfc(:,:,:) = 0._wp 369 IF(lwp) THEN 370 WRITE(numout,*) 371 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 372 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 373 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 374 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 375 ENDIF 376 qtr_cfc(:,:,:) = 0._wp 377 qint_cfc(:,:,:) = 0._wp 378 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 379 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 380 ENDIF 381 !! 382 !! 2 -- Hindcast/proj 383 ELSEIF (simu_type==2) THEN 384 iyear_beg = MOD(nyear, 100) 385 IF (iyear_beg < 20) iyear_beg = iyear_beg + 100 386 IF ((iyear_beg < 30) .OR. (iyear_beg > 115)) THEN 387 qtr_cfc(:,:,:) = 0._wp 388 IF(lwp) THEN 389 WRITE(numout,*) 390 WRITE(numout,*) 'restart a CFC cycle or out of P_cfc year bounds zero --' 391 WRITE(numout,*) ' -- set qtr_CFC = 0.00 --' 392 WRITE(numout,*) ' -- set qint_CFC = 0.00 --' 393 WRITE(numout,*) ' -- set trn(CFC) = 0.00 --' 394 ENDIF 395 qtr_cfc(:,:,:) = 0._wp 396 qint_cfc(:,:,:) = 0._wp 397 trn(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 398 trb(:,:,:,jp_cfc0:jp_cfc1) = 0._wp 399 ENDIF 264 400 ENDIF 401 265 402 IF(lwp) WRITE(numout,*) 266 403 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r7203 r8280 29 29 USE trdtra 30 30 USE prtctl_trc ! Print control 31 !! USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 32 32 33 IMPLICIT NONE … … 73 74 INTEGER, INTENT(in) :: kt ! ocean time-step index 74 75 ! 75 INTEGER :: jk 76 INTEGER :: jk, jn 76 77 CHARACTER (len=22) :: charout 77 78 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn ! effective velocity … … 108 109 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 109 110 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 111 ! 112 !! Jpalm -- 14-01-2016 -- restart and proc pb - try this... 113 !! DO jn = 1, jptra 114 !! CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. ) 115 !! CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. ) 116 !! END DO 117 ! 110 118 111 119 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90
r6498 r8280 102 102 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 103 103 104 IF( ln_rsttr .AND. & ! Restart: read in restart file 105 iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 106 IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 107 zfact = 0.5_wp 108 DO jn = 1, jptra 109 CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 110 END DO 111 ELSE ! No restart or restart not found: Euler forward time stepping 104 !! JPALM -- 12-01-2016 -- problem after restart, maybe because of this... 105 !! -- set sbc_trc_b to 0 after restart, first, to check. 106 !!------------------------------------------------------------------------------ 107 ! IF( ln_rsttr .AND. & ! Restart: read in restart file 108 ! iom_varid( numrtr, 'sbc_'//TRIM(ctrcnm(1))//'_b', ldstop = .FALSE. ) > 0 ) THEN 109 ! IF(lwp) WRITE(numout,*) ' nittrc000-nn_dttrc surface tracer content forcing fields red in the restart file' 110 ! zfact = 0.5_wp 111 ! DO jn = 1, jptra 112 ! CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) ) ! before tracer content sbc 113 ! END DO 114 ! ELSE ! No restart or restart not found: Euler forward time stepping 112 115 zfact = 1._wp 113 116 sbc_trc_b(:,:,:) = 0._wp 114 ENDIF117 ! ENDIF 115 118 ELSE ! Swap of forcing fields 116 119 IF( ln_top_euler ) THEN -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r6498 r8280 27 27 USE trcsbc ! surface boundary condition (trc_sbc routine) 28 28 USE zpshde ! partial step: hor. derivative (zps_hde routine) 29 # if defined key_debug_medusa 30 USE trcrst 31 # endif 32 29 33 30 34 #if defined key_agrif … … 65 69 ! 66 70 CALL trc_sbc( kstp ) ! surface boundary condition 71 # if defined key_debug_medusa 72 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_sbc at kt =', kstp 73 CALL trc_rst_tra_stat 74 CALL flush(numout) 75 # endif 67 76 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 77 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 78 CALL trc_adv( kstp ) ! horizontal & vertical advection 79 # if defined key_debug_medusa 80 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp 81 CALL trc_rst_tra_stat 82 CALL flush(numout) 83 # endif 70 84 CALL trc_ldf( kstp ) ! lateral mixing 71 85 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & … … 75 89 #endif 76 90 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 91 # if defined key_debug_medusa 92 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp 93 CALL trc_rst_tra_stat 94 CALL flush(numout) 95 # endif 77 96 CALL trc_nxt( kstp ) ! tracer fields at next time step 97 # if defined key_debug_medusa 98 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_nxt at kt =', kstp 99 CALL trc_rst_tra_stat 100 CALL flush(numout) 101 # endif 78 102 IF( ln_trcrad ) CALL trc_rad( kstp ) ! Correct artificial negative concentrations 79 103 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r7203 r8280 8 8 !! 1.0 ! 2004-03 (C. Ethe) Free form and module 9 9 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) revised architecture 10 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 10 11 !!---------------------------------------------------------------------- 11 12 USE par_kind ! kind parameters … … 15 16 USE par_cfc ! CFC 11 and 12 tracers 16 17 USE par_my_trc ! user defined passive tracers 18 USE par_medusa ! MEDUSA model 19 USE par_idtra ! Idealize tracer 20 USE par_age ! AGE tracer 17 21 18 22 IMPLICIT NONE … … 24 28 ! Passive tracers : Total size 25 29 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 26 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc 27 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d 28 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d 30 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_my_trc + jp_medusa + jp_idtra + jp_age 31 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_my_trc_2d + jp_medusa_2d + jp_idtra_2d + jp_age_2d 32 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_my_trc_3d + jp_medusa_3d + jp_idtra_3d + jp_age_3d 29 33 ! ! total number of sms diagnostic arrays 30 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 34 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd 31 35 32 36 ! 1D configuration ("key_c1d") -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trc.F90
r6486 r8280 7 7 !! - ! 2000-04 (O. Aumont, M.A. Foujols) HAMOCC3 and P3ZD 8 8 !! NEMO 1.0 ! 2004-03 (C. Ethe) Free form and module 9 !! 3.6 ! 2016-11 (A. Yool) Updated diags for CMIP6 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_top … … 25 26 INTEGER, PUBLIC :: numnat_cfg = -1 !: logical unit for the reference passive tracer namelist_top_cfg 26 27 INTEGER, PUBLIC :: numont = -1 !: logical unit for the reference passive tracer namelist output output.namelist.top 27 INTEGER, PUBLIC :: numstr !: logical unit for tracer statistics28 INTEGER, PUBLIC :: numstr = -1 !: logical unit for tracer statistics 28 29 INTEGER, PUBLIC :: numrtr !: logical unit for trc restart (read ) 29 30 INTEGER, PUBLIC :: numrtw !: logical unit for trc restart ( write ) … … 104 105 END TYPE DIAG 105 106 107 #if defined key_medusa && defined key_iomput 108 TYPE, PUBLIC :: BDIAG 109 LOGICAL :: dgsave 110 END TYPE BDIAG 111 112 TYPE, PUBLIC :: DIAG_IOM 113 TYPE(BDIAG) INVTN, INVTSI, INVTFE, PRN, MPN, PRD, MPD, DSED, OPAL, OPALDISS, GMIPn, & 114 GMID, MZMI, GMEPN, GMEPD, GMEZMI, GMED, MZME, DEXP, DETN, MDET, AEOLIAN, BENTHIC, & 115 SCAVENGE, PN_JLIM, PN_NLIM, PN_FELIM, PD_JLIM, PD_NLIM, PD_FELIM, PD_SILIM, & 116 PDSILIM2, SDT__100, SDT__200, SDT__500, SDT_1000, TOTREG_N, TOTRG_SI, REG__100, & 117 REG__200, REG__500, REG_1000, FASTN, FASTSI, FASTFE, FASTC, FASTCA, FDT__100, & 118 FDT__200, FDT__500, FDT_1000, RG__100F, RG__200F, RG__500F, RG_1000F, FDS__100, & 119 FDS__200, FDS__500, FDS_1000, RGS_100F, RGS_200F, RGS_500F, RGS1000F, REMINN, & 120 REMINSI, REMINFE, REMINC, REMINCA, SEAFLRN, SEAFLRSI, SEAFLRFE, SEAFLRC, SEAFLRCA, & 121 MED_QSR, MED_XPAR, INTFLX_N, INTFLX_SI, INTFLX_FE, INT_PN, INT_PD, ML_PRN, ML_PRD, & 122 OCAL_CCD, OCAL_LVL, FE_0000, FE_0100, FE_0200, FE_0500, FE_1000, MED_XZE, WIND, & 123 ATM_PCO2, OCN_PH, OCN_PCO2, OCNH2CO3, OCN_HCO3, OCN_CO3, CO2FLUX, OM_CAL, OM_ARG, & 124 TCO2, TALK, KW660, ATM_PP0, O2FLUX, O2SAT, CAL_CCD, ARG_CCD, SFR_OCAL, SFR_OARG, & 125 N_PROD, N_CONS, C_PROD, C_CONS, O2_PROD, O2_CONS, O2_ANOX, RR_0100, RR_0500, & 126 RR_1000, IBEN_N, IBEN_FE, IBEN_C, IBEN_SI, IBEN_CA, OBEN_N, OBEN_FE, OBEN_C, & 127 OBEN_SI, OBEN_CA, BEN_N, BEN_FE, BEN_C, BEN_SI, BEN_CA, RUNOFF, RIV_N, RIV_SI, & 128 RIV_C, RIV_ALK, DETC, SDC__100, SDC__200, SDC__500, SDC_1000, INVTC, INVTALK, & 129 INVTO2, LYSO_CA, COM_RESP, PN_LLOSS, PD_LLOSS, ZI_LLOSS, ZE_LLOSS, ZI_MES_N, & 130 ZI_MES_D, ZI_MES_C, ZI_MESDC, ZI_EXCR, ZI_RESP, ZI_GROW, ZE_MES_N, ZE_MES_D, & 131 ZE_MES_C, ZE_MESDC, ZE_EXCR, ZE_RESP, ZE_GROW, MDETC, GMIDC, GMEDC, & 132 INT_ZMI, INT_ZME, INT_DET, INT_DTC, DMS_SURF, DMS_ANDR, DMS_SIMO, DMS_ARAN, & 133 DMS_HALL, DMS_ANDM, ATM_XCO2, OCN_FCO2, ATM_FCO2, OCN_RHOSW, OCN_SCHCO2, & 134 OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2, & ! end of regular 2D 135 TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3, & ! end of regular 3D 136 ! AXY (11/11/16): additional CMIP6 2D diagnostics 137 epC100, epCALC100, epN100, epSI100, & 138 FGCO2, INTDISSIC, INTDISSIN, INTDISSISI, INTTALK, O2min, ZO2min, & 139 FBDDTALK, FBDDTDIC, FBDDTDIFE, FBDDTDIN, FBDDTDISI, & 140 ! AXY (11/11/16): additional CMIP6 3D diagnostics 141 TPPD3, & 142 BDDTALK3, BDDTDIC3, BDDTDIFE3, BDDTDIN3, BDDTDISI3, & 143 FD_NIT3, FD_SIL3, FD_CAR3, FD_CAL3, & 144 CO33, CO3SATARAG3, CO3SATCALC3, DCALC3, & 145 EXPC3, EXPN3, EXPCALC3, EXPSI3, & 146 FEDISS3, FESCAV3, & 147 MIGRAZP3, MIGRAZD3, MEGRAZP3, MEGRAZD3, MEGRAZZ3, & 148 O2SAT3, PBSI3, PCAL3, REMOC3, & 149 PNLIMJ3, PNLIMN3, PNLIMFE3, PDLIMJ3, PDLIMN3, PDLIMFE3, PDLIMSI3 150 !! 151 !! list of all MEDUSA diagnostics that could be called by iom_use 152 END TYPE DIAG_IOM 153 !! 154 TYPE(DIAG_IOM), PUBLIC :: med_diag ! define which diagnostics are asked in outputs 155 # endif 156 106 157 !! information for inputs 107 158 !! -------------------------------------------------- … … 216 267 217 268 IF( trc_alloc /= 0 ) CALL ctl_warn('trc_alloc: failed to allocate arrays') 269 270 ! It is known that not intialising SBC_TRC can introduce NaNs 271 sbc_trc(:,:,:) = 0.0 272 218 273 ! 219 274 END FUNCTION trc_alloc -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r7203 r8280 8 8 !! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture 9 9 !! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_top … … 24 25 USE trcini_c14b ! C14 bomb initialisation 25 26 USE trcini_my_trc ! MY_TRC initialisation 27 USE trcini_medusa ! MEDUSA initialisation 28 USE trcini_idtra ! idealize tracer initialisation 29 USE trcini_age ! AGE initialisation 26 30 USE trcdta ! initialisation from files 27 31 USE daymod ! calendar manager … … 76 80 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 77 81 & Computation of a daily mean shortwave for some biogeochemical models) ') 78 82 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 83 !!!!! CHECK For MEDUSA 84 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 79 85 IF( nn_cla == 1 ) & 80 86 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) … … 97 103 98 104 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 105 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers 106 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers 99 107 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 100 108 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 109 IF( lk_age ) CALL trc_ini_age ! AGE tracer 101 110 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 102 111 103 112 CALL trc_ice_ini ! Tracers in sea ice 104 113 105 IF( lwp ) THEN 114 # if defined key_debug_medusa 115 IF (lwp) write (numout,*) '------------------------------' 116 IF (lwp) write (numout,*) 'Jpalm - debug' 117 IF (lwp) write (numout,*) ' in trc_init' 118 IF (lwp) write (numout,*) ' sms init OK' 119 IF (lwp) write (numout,*) ' next: open tracer.stat' 120 IF (lwp) write (numout,*) ' ' 121 CALL flush(numout) 122 # endif 123 124 IF( ln_ctl ) THEN 106 125 ! 107 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 126 IF (narea == 1) THEN 127 ! The tracer.stat file only contains global tracer sum values, if 128 ! it contains anything at all. Hence it only needs to be opened 129 ! and written to on the master PE, not on all PEs. 130 CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED', & 131 'SEQUENTIAL', -1, numout, lwp , narea ) 132 ENDIF 108 133 ! 109 134 ENDIF 110 135 111 IF( ln_trcdta ) CALL trc_dta_init(jptra) 112 136 # if defined key_debug_medusa 137 IF (lwp) write (numout,*) '------------------------------' 138 IF (lwp) write (numout,*) 'Jpalm - debug' 139 IF (lwp) write (numout,*) ' in trc_init' 140 IF (lwp) write (numout,*) 'open tracer.stat -- OK' 141 IF (lwp) write (numout,*) ' ' 142 CALL flush(numout) 143 # endif 144 145 146 IF( ln_trcdta ) THEN 147 #if defined key_medusa 148 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init' 149 IF(lwp) CALL flush(numout) 150 #endif 151 CALL trc_dta_init(jptra) 152 ENDIF 113 153 114 154 IF( ln_rsttr ) THEN 115 155 ! 156 #if defined key_medusa 157 IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read' 158 IF(lwp) CALL flush(numout) 159 #endif 116 160 CALL trc_rst_read ! restart from a file 117 161 ! 118 162 ELSE 163 ! 164 # if defined key_debug_medusa 165 IF (lwp) write (numout,*) '------------------------------' 166 IF (lwp) write (numout,*) 'Jpalm - debug' 167 IF (lwp) write (numout,*) ' Init from file -- will call trc_dta' 168 IF (lwp) write (numout,*) ' ' 169 CALL flush(numout) 170 # endif 119 171 ! 120 172 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping … … 137 189 ENDIF 138 190 ! 191 # if defined key_debug_medusa 192 IF (lwp) write (numout,*) '------------------------------' 193 IF (lwp) write (numout,*) 'Jpalm - debug' 194 IF (lwp) write (numout,*) ' in trc_init' 195 IF (lwp) write (numout,*) ' before trb = trn' 196 IF (lwp) write (numout,*) ' ' 197 CALL flush(numout) 198 # endif 199 ! 139 200 trb(:,:,:,:) = trn(:,:,:,:) 201 ! 202 # if defined key_debug_medusa 203 IF (lwp) write (numout,*) '------------------------------' 204 IF (lwp) write (numout,*) 'Jpalm - debug' 205 IF (lwp) write (numout,*) ' in trc_init' 206 IF (lwp) write (numout,*) ' trb = trn -- OK' 207 IF (lwp) write (numout,*) ' ' 208 CALL flush(numout) 209 # endif 140 210 ! 141 211 ENDIF … … 146 216 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) & 147 217 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level 148 149 218 ! 219 # if defined key_debug_medusa 220 IF (lwp) write (numout,*) '------------------------------' 221 IF (lwp) write (numout,*) 'Jpalm - debug' 222 IF (lwp) write (numout,*) ' in trc_init' 223 IF (lwp) write (numout,*) ' partial step -- OK' 224 IF (lwp) write (numout,*) ' ' 225 CALL flush(numout) 226 # endif 150 227 ! 151 228 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 152 229 ! 153 230 # if defined key_debug_medusa 231 IF (lwp) write (numout,*) '------------------------------' 232 IF (lwp) write (numout,*) 'Jpalm - debug' 233 IF (lwp) write (numout,*) ' in trc_init' 234 IF (lwp) write (numout,*) ' before initiate tracer contents' 235 IF (lwp) write (numout,*) ' ' 236 CALL flush(numout) 237 # endif 238 ! 154 239 trai(:) = 0._wp ! initial content of all tracers 155 240 DO jn = 1, jptra … … 164 249 WRITE(numout,*) ' *** Total inital content of all tracers ' 165 250 WRITE(numout,*) 251 # if defined key_debug_medusa 252 CALL flush(numout) 253 # endif 254 ! 255 # if defined key_debug_medusa 256 WRITE(numout,*) ' litle check : ', ctrcnm(1) 257 CALL flush(numout) 258 # endif 166 259 DO jn = 1, jptra 167 260 WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) … … 176 269 CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 177 270 ENDIF 271 272 IF(lwp) WRITE(numout,*) 273 IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed' 274 IF(lwp) WRITE(numout,*) '~~~~~~~' 275 IF(lwp) CALL flush(numout) 276 # if defined key_debug_medusa 277 CALL trc_rst_stat 278 CALL flush(numout) 279 # endif 280 178 281 9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10) 179 282 ! -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r7203 r8280 11 11 !! - ! 2001-01 (E Kestenare) suppress ndttrc=1 for CEN2 and TVD schemes 12 12 !! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90 13 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 13 14 !!---------------------------------------------------------------------- 14 15 #if defined key_top … … 25 26 USE trcnam_c14b ! C14 SMS namelist 26 27 USE trcnam_my_trc ! MY_TRC SMS namelist 28 USE trcnam_medusa ! MEDUSA namelist 29 USE trcnam_idtra ! Idealise tracer namelist 30 USE trcnam_age ! AGE SMS namelist 27 31 USE trd_oce 28 32 USE trdtrc_oce … … 54 58 !! ** Method : - read passive tracer namelist 55 59 !! - read namelist of each defined SMS model 56 !! ( (PISCES, CFC, MY_TRC )57 !!--------------------------------------------------------------------- 58 INTEGER :: jn ! dummy loop indice60 !! ( (PISCES, CFC, MY_TRC, MEDUSA, IDTRA, Age ) 61 !!--------------------------------------------------------------------- 62 INTEGER :: jn, jk ! dummy loop indice 59 63 ! ! Parameters of the run 60 64 IF( .NOT. lk_offline ) CALL trc_nam_run 61 65 62 66 ! ! passive tracer informations 67 # if defined key_debug_medusa 68 CALL flush(numout) 69 IF (lwp) write (numout,*) '------------------------------' 70 IF (lwp) write (numout,*) 'Jpalm - debug' 71 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc' 72 IF (lwp) write (numout,*) ' ' 73 # endif 74 ! 63 75 CALL trc_nam_trc 64 76 65 77 ! ! Parameters of additional diagnostics 78 # if defined key_debug_medusa 79 CALL flush(numout) 80 IF (lwp) write (numout,*) '------------------------------' 81 IF (lwp) write (numout,*) 'Jpalm - debug' 82 IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK' 83 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia' 84 IF (lwp) write (numout,*) ' ' 85 # endif 86 ! 87 66 88 CALL trc_nam_dia 67 89 68 90 ! ! namelist of transport 91 # if defined key_debug_medusa 92 CALL flush(numout) 93 IF (lwp) write (numout,*) '------------------------------' 94 IF (lwp) write (numout,*) 'Jpalm - debug' 95 IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK' 96 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp' 97 IF (lwp) write (numout,*) ' ' 98 # endif 99 ! 69 100 CALL trc_nam_trp 101 ! 102 # if defined key_debug_medusa 103 CALL flush(numout) 104 IF (lwp) write (numout,*) '------------------------------' 105 IF (lwp) write (numout,*) 'Jpalm - debug' 106 IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK' 107 IF (lwp) write (numout,*) 'continue trc_nam ' 108 IF (lwp) write (numout,*) ' ' 109 CALL flush(numout) 110 # endif 111 ! 70 112 71 113 … … 89 131 END DO 90 132 WRITE(numout,*) ' ' 133 # if defined key_debug_medusa 134 CALL flush(numout) 135 # endif 91 136 ENDIF 92 137 … … 107 152 WRITE(numout,*) 108 153 ENDIF 109 ENDIF 110 154 # if defined key_debug_medusa 155 CALL flush(numout) 156 # endif 157 ENDIF 158 159 # if defined key_debug_medusa 160 DO jk = 1, jpk 161 WRITE(numout,*) ' level number: ', jk, 'rdttrc: ',rdttrc(jk),'rdttra: ', rdttra(jk),'nn_dttrc: ', nn_dttrc 162 END DO 163 CALL flush(numout) 164 # endif 111 165 112 166 rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc ) ! vertical profile of passive tracer time-step … … 116 170 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc(1) 117 171 WRITE(numout,*) 172 # if defined key_debug_medusa 173 CALL flush(numout) 174 # endif 118 175 ENDIF 119 176 … … 143 200 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 144 201 END DO 202 WRITE(numout,*) ' ' 203 CALL flush(numout) 145 204 ENDIF 146 205 #endif 147 206 207 # if defined key_debug_medusa 208 CALL flush(numout) 209 IF (lwp) write (numout,*) '------------------------------' 210 IF (lwp) write (numout,*) 'Jpalm - debug' 211 IF (lwp) write (numout,*) 'just before ice module for tracers call : ' 212 IF (lwp) write (numout,*) ' ' 213 # endif 214 ! 148 215 149 216 ! Call the ice module for tracers 150 217 ! ------------------------------- 151 218 CALL trc_nam_ice 219 220 # if defined key_debug_medusa 221 CALL flush(numout) 222 IF (lwp) write (numout,*) '------------------------------' 223 IF (lwp) write (numout,*) 'Jpalm - debug' 224 IF (lwp) write (numout,*) 'Will now read SMS namelists : ' 225 IF (lwp) write (numout,*) ' ' 226 # endif 227 ! 152 228 153 229 ! namelist of SMS … … 156 232 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 157 233 ENDIF 158 234 ! 235 # if defined key_debug_medusa 236 CALL flush(numout) 237 IF (lwp) write (numout,*) '------------------------------' 238 IF (lwp) write (numout,*) 'Jpalm - debug' 239 IF (lwp) write (numout,*) 'CALL trc_nam_pisces -- OK' 240 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 241 IF (lwp) write (numout,*) ' ' 242 # endif 243 ! 244 IF( lk_medusa ) THEN ; CALL trc_nam_medusa ! MEDUSA tracers 245 ELSE ; IF(lwp) WRITE(numout,*) ' MEDUSA not used' 246 ENDIF 247 ! 248 # if defined key_debug_medusa 249 CALL flush(numout) 250 IF (lwp) write (numout,*) '------------------------------' 251 IF (lwp) write (numout,*) 'Jpalm - debug' 252 IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK' 253 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra' 254 IF (lwp) write (numout,*) ' ' 255 # endif 256 ! 257 IF( lk_idtra ) THEN ; CALL trc_nam_idtra ! Idealize tracers 258 ELSE ; IF(lwp) WRITE(numout,*) ' Idealize tracers not used' 259 ENDIF 260 ! 261 # if defined key_debug_medusa 262 CALL flush(numout) 263 IF (lwp) write (numout,*) '------------------------------' 264 IF (lwp) write (numout,*) 'Jpalm - debug' 265 IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK' 266 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc' 267 IF (lwp) write (numout,*) ' ' 268 # endif 269 ! 159 270 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers 160 271 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 161 272 ENDIF 162 273 ! 274 # if defined key_debug_medusa 275 CALL flush(numout) 276 IF (lwp) write (numout,*) '------------------------------' 277 IF (lwp) write (numout,*) 'Jpalm - debug' 278 IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK' 279 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14' 280 IF (lwp) write (numout,*) ' ' 281 # endif 282 ! 163 283 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 164 284 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 165 285 ENDIF 166 286 ! 287 # if defined key_debug_medusa 288 CALL flush(numout) 289 IF (lwp) write (numout,*) '------------------------------' 290 IF (lwp) write (numout,*) 'Jpalm - debug' 291 IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK' 292 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age' 293 IF (lwp) write (numout,*) ' ' 294 # endif 295 ! 296 IF( lk_age ) THEN ; CALL trc_nam_age ! AGE tracer 297 ELSE ; IF(lwp) WRITE(numout,*) ' AGE not used' 298 ENDIF 299 ! 300 # if defined key_debug_medusa 301 CALL flush(numout) 302 IF (lwp) write (numout,*) '------------------------------' 303 IF (lwp) write (numout,*) 'Jpalm - debug' 304 IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK' 305 IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK' 306 IF (lwp) write (numout,*) ' ' 307 # endif 308 ! 167 309 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 168 310 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 169 311 ENDIF 170 ! 312 313 IF(lwp) CALL flush(numout) 171 314 END SUBROUTINE trc_nam 172 315 … … 216 359 WRITE(numout,*) ' Use euler integration for TRC (y/n) ln_top_euler = ', ln_top_euler 217 360 WRITE(numout,*) ' ' 361 CALL flush(numout) 218 362 ENDIF 219 363 ! … … 306 450 ln_trc_wri(jn) = sn_tracer(jn)%llsave 307 451 END DO 308 452 IF(lwp) CALL flush(numout) 453 309 454 END SUBROUTINE trc_nam_trc 310 455 … … 357 502 WRITE(numout,*) ' frequency of outputs for biological trends nn_writebio = ', nn_writebio 358 503 WRITE(numout,*) ' ' 359 ENDIF 360 361 IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 504 CALL flush(numout) 505 ENDIF 506 !! 507 !! JPALM -- 17-07-2015 -- 508 !! MEDUSA is not yet up-to-date with the iom server. 509 !! we use it for the main tracer, but not fully with diagnostics. 510 !! will have to adapt it properly when visiting Christian Ethee 511 !! for now, we change 512 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 513 !! to : 514 !! 515 IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 362 516 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 363 517 & ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) , & … … 368 522 trc3d(:,:,:,:) = 0._wp ; ctrc3d(:) = ' ' ; ctrc3l(:) = ' ' ; ctrc3u(:) = ' ' 369 523 ! 524 !! ELSE IF ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN 525 !! CALL trc_nam_iom_medusa 370 526 ENDIF 371 527 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r7203 r8280 27 27 USE trcnam_trp 28 28 USE iom 29 USE ioipsl, ONLY : ju2ymds ! for calendar 29 30 USE daymod 31 !! AXY (05/11/13): need these for MEDUSA to input/output benthic reservoirs 32 USE sms_medusa 33 USE trcsms_medusa 34 !! 35 #if defined key_idtra 36 USE trcsms_idtra 37 #endif 38 !! 39 #if defined key_cfc 40 USE trcsms_cfc 41 #endif 42 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 43 USE sbc_oce, ONLY: lk_oasis 44 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable 45 30 46 IMPLICIT NONE 31 47 PRIVATE … … 35 51 PUBLIC trc_rst_wri ! called by ??? 36 52 PUBLIC trc_rst_cal 53 PUBLIC trc_rst_stat 54 PUBLIC trc_rst_dia_stat 55 PUBLIC trc_rst_tra_stat 37 56 38 57 !! * Substitutions … … 48 67 !!---------------------------------------------------------------------- 49 68 INTEGER, INTENT(in) :: kt ! number of iteration 69 INTEGER :: iyear, imonth, iday 70 REAL (wp) :: zsec 71 REAL (wp) :: zfjulday 50 72 ! 51 73 CHARACTER(LEN=20) :: clkt ! ocean time-step define as a character … … 78 100 ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 79 101 IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 80 ! beware of the format used to write kt (default is i8.8, that should be large enough) 81 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 82 ELSE ; WRITE(clkt,'(i8.8)') nitrst 102 IF ( ln_rstdate ) THEN 103 !! JPALM -- 22-12-2015 -- modif to get the good date on restart trc file name 104 !! -- the condition to open the rst file is not the same than for the dynamic rst. 105 !! -- here it - for an obscure reason - is open 2 time-step before the restart writing process 106 !! instead of 1. 107 !! -- i am not sure if someone forgot +1 in the if loop condition as 108 !! it is writen in all comments nitrst -2*nn_dttrc + 1 and the condition is 109 !! nitrst - 2*nn_dttrc 110 !! -- nevertheless we didn't wanted to broke something already working 111 !! and just adapted the part we added. 112 !! -- So instead of calling ju2ymds( fjulday + (rdttra(1)) 113 !! we call ju2ymds( fjulday + (2*rdttra(1)) 114 !!-------------------------------------------------------------------- 115 zfjulday = fjulday + (2*rdttra(1)) / rday 116 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 117 CALL ju2ymds( zfjulday + (2*rdttra(1)) / rday, iyear, imonth, iday, zsec ) 118 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 119 ELSE 120 ! beware of the format used to write kt (default is i8.8, that should be large enough) 121 IF( nitrst > 1.0e9 ) THEN ; WRITE(clkt,* ) nitrst 122 ELSE ; WRITE(clkt,'(i8.8)') nitrst 123 ENDIF 83 124 ENDIF 84 125 ! create the file … … 101 142 !! ** purpose : read passive tracer fields in restart files 102 143 !!---------------------------------------------------------------------- 103 INTEGER :: jn 144 INTEGER :: jn, jl 145 !! AXY (05/11/13): temporary variables 146 REAL(wp) :: fq0,fq1,fq2 104 147 105 148 !!---------------------------------------------------------------------- … … 112 155 DO jn = 1, jptra 113 156 CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 157 trn(:,:,:,jn) = trn(:,:,:,jn) * tmask(:,:,:) 114 158 END DO 115 159 116 160 DO jn = 1, jptra 117 161 CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 118 END DO 162 trb(:,:,:,jn) = trb(:,:,:,jn) * tmask(:,:,:) 163 END DO 164 ! 165 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 166 !! call to MEDUSA-2 at this point; this suggests that the FCM 167 !! version of NEMO date significantly earlier than the current 168 !! version 169 170 #if defined key_medusa 171 !! AXY (13/01/12): check if the restart contains sediment fields; 172 !! this is only relevant for simulations that include 173 !! biogeochemistry and are restarted from earlier runs 174 !! in which there was no sediment component 175 !! 176 IF( iom_varid( numrtr, 'B_SED_N', ldstop = .FALSE. ) > 0 ) THEN 177 !! YES; in which case read them 178 !! 179 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields present - reading in ...' 180 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_N', zb_sed_n(:,:) ) 181 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_N', zn_sed_n(:,:) ) 182 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_FE', zb_sed_fe(:,:) ) 183 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_FE', zn_sed_fe(:,:) ) 184 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_SI', zb_sed_si(:,:) ) 185 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_SI', zn_sed_si(:,:) ) 186 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_C', zb_sed_c(:,:) ) 187 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_C', zn_sed_c(:,:) ) 188 CALL iom_get( numrtr, jpdom_autoglo, 'B_SED_CA', zb_sed_ca(:,:) ) 189 CALL iom_get( numrtr, jpdom_autoglo, 'N_SED_CA', zn_sed_ca(:,:) ) 190 ELSE 191 !! NO; in which case set them to zero 192 !! 193 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields absent - setting to zero ...' 194 zb_sed_n(:,:) = 0.0 !! organic N 195 zn_sed_n(:,:) = 0.0 196 zb_sed_fe(:,:) = 0.0 !! organic Fe 197 zn_sed_fe(:,:) = 0.0 198 zb_sed_si(:,:) = 0.0 !! inorganic Si 199 zn_sed_si(:,:) = 0.0 200 zb_sed_c(:,:) = 0.0 !! organic C 201 zn_sed_c(:,:) = 0.0 202 zb_sed_ca(:,:) = 0.0 !! inorganic C 203 zn_sed_ca(:,:) = 0.0 204 ENDIF 205 !! 206 !! calculate stats on these fields 207 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 208 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 209 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 210 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 211 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 212 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 213 !! 214 !! AXY (07/07/15): read in temporally averaged fields for DMS 215 !! calculations 216 !! 217 IF( iom_varid( numrtr, 'B_DMS_CHN', ldstop = .FALSE. ) > 0 ) THEN 218 !! YES; in which case read them 219 !! 220 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS present - reading in ...' 221 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHN', zb_dms_chn(:,:) ) 222 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHN', zn_dms_chn(:,:) ) 223 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_CHD', zb_dms_chd(:,:) ) 224 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_CHD', zn_dms_chd(:,:) ) 225 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_MLD', zb_dms_mld(:,:) ) 226 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_MLD', zn_dms_mld(:,:) ) 227 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 228 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 229 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_DIN', zb_dms_din(:,:) ) 230 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_DIN', zn_dms_din(:,:) ) 231 ELSE 232 !! NO; in which case set them to zero 233 !! 234 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS absent - setting to zero ...' 235 zb_dms_chn(:,:) = 0.0 !! CHN 236 zn_dms_chn(:,:) = 0.0 237 zb_dms_chd(:,:) = 0.0 !! CHD 238 zn_dms_chd(:,:) = 0.0 239 zb_dms_mld(:,:) = 0.0 !! MLD 240 zn_dms_mld(:,:) = 0.0 241 zb_dms_qsr(:,:) = 0.0 !! QSR 242 zn_dms_qsr(:,:) = 0.0 243 zb_dms_din(:,:) = 0.0 !! DIN 244 zn_dms_din(:,:) = 0.0 245 ENDIF 246 !! 247 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 248 !! -- needed for the coupling with atm 249 IF( iom_varid( numrtr, 'N_DMS_srf', ldstop = .FALSE. ) > 0 ) THEN 250 IF(lwp) WRITE(numout,*) 'DMS surf concentration - reading in ...' 251 CALL iom_get( numrtr, jpdom_autoglo, 'B_DMS_srf', zb_dms_srf(:,:) ) 252 CALL iom_get( numrtr, jpdom_autoglo, 'N_DMS_srf', zn_dms_srf(:,:) ) 253 ELSE 254 IF(lwp) WRITE(numout,*) 'DMS surf concentration - setting to zero ...' 255 zb_dms_srf(:,:) = 0.0 !! DMS 256 zn_dms_srf(:,:) = 0.0 257 ENDIF 258 IF (lk_oasis) THEN 259 DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable 260 END IF 261 !! 262 IF( iom_varid( numrtr, 'B_CO2_flx', ldstop = .FALSE. ) > 0 ) THEN 263 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - reading in ...' 264 CALL iom_get( numrtr, jpdom_autoglo, 'B_CO2_flx', zb_co2_flx(:,:) ) 265 CALL iom_get( numrtr, jpdom_autoglo, 'N_CO2_flx', zn_co2_flx(:,:) ) 266 ELSE 267 IF(lwp) WRITE(numout,*) 'CO2 air-sea flux - setting to zero ...' 268 zb_co2_flx(:,:) = 0.0 !! CO2 flx 269 zn_co2_flx(:,:) = 0.0 270 ENDIF 271 IF (lk_oasis) THEN 272 CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable 273 END IF 274 !! 275 !! JPALM 02-06-2017 -- in complement to DMS surf 276 !! -- the atm model needs surf Chl 277 !! as proxy of org matter from the ocean 278 !! -- needed for the coupling with atm 279 IF( iom_varid( numrtr, 'N_CHL_srf', ldstop = .FALSE. ) > 0 ) THEN 280 IF(lwp) WRITE(numout,*) 'Chl surf concentration - reading in ...' 281 CALL iom_get( numrtr, jpdom_autoglo, 'N_CHL_srf', zn_chl_srf(:,:) ) 282 ELSE 283 IF(lwp) WRITE(numout,*) 'Chl surf concentration - setting to zero ...' 284 zn_chl_srf(:,:) = (trn(:,:,1,jpchn) + trn(:,:,1,jpchd)) * 1.E-6 285 ENDIF 286 IF (lk_oasis) THEN 287 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling variable 288 END IF 289 !! 290 !! calculate stats on these fields 291 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 292 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 293 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 294 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 295 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 296 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 297 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 298 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 299 call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 300 !! 301 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 302 !! -- needed for monthly call of carb-chem routine and better reproducibility 303 # if defined key_roam 304 IF( iom_varid( numrtr, 'pH_3D', ldstop = .FALSE. ) > 0 ) THEN 305 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - reading in ...' 306 CALL iom_get( numrtr, jpdom_autoglo, 'pH_3D' , f3_pH(:,:,:) ) 307 CALL iom_get( numrtr, jpdom_autoglo, 'h2CO3_3D', f3_h2co3(:,:,:) ) 308 CALL iom_get( numrtr, jpdom_autoglo, 'hCO3_3D' , f3_hco3(:,:,:) ) 309 CALL iom_get( numrtr, jpdom_autoglo, 'CO3_3D' , f3_co3(:,:,:) ) 310 CALL iom_get( numrtr, jpdom_autoglo, 'omcal_3D', f3_omcal(:,:,:) ) 311 CALL iom_get( numrtr, jpdom_autoglo, 'omarg_3D', f3_omarg(:,:,:) ) 312 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_CAL' , f2_ccd_cal(:,:) ) 313 CALL iom_get( numrtr, jpdom_autoglo, 'CCD_ARG' , f2_ccd_arg(:,:) ) 314 !! 315 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 316 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 317 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 318 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 319 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 320 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 321 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 322 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 323 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 324 325 ELSE 326 IF(lwp) WRITE(numout,*) 'WARNING : No Carbonate-chem variable in the restart.... ' 327 IF(lwp) WRITE(numout,*) 'Is not a problem if start a month, but may be very problematic if not ' 328 IF(lwp) WRITE(numout,*) 'Check if mod(kt*rdt,2592000) == rdt' 329 IF(lwp) WRITE(numout,*) 'Or don t start from uncomplete restart...' 330 ENDIF 331 # endif 332 333 334 #endif 335 ! 336 #if defined key_idtra 337 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 338 !! writting here undre their key. 339 !! problems in CFC restart, maybe because of this... 340 !! and pb in idtra diag or diad-restart writing. 341 !!---------------------------------------------------------------------- 342 IF( iom_varid( numrtr, 'qint_IDTRA', ldstop = .FALSE. ) > 0 ) THEN 343 !! YES; in which case read them 344 !! 345 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties present - reading in ...' 346 CALL iom_get( numrtr, jpdom_autoglo, 'qint_IDTRA', qint_idtra(:,:,1) ) 347 ELSE 348 !! NO; in which case set them to zero 349 !! 350 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties absent - setting to zero ...' 351 qint_idtra(:,:,1) = 0.0 !! CHN 352 ENDIF 353 !! 354 !! calculate stats on these fields 355 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 356 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 357 #endif 358 ! 359 #if defined key_cfc 360 DO jl = 1, jp_cfc 361 jn = jp_cfc0 + jl - 1 362 IF( iom_varid( numrtr, 'qint_'//ctrcnm(jn), ldstop = .FALSE. ) > 0 ) THEN 363 !! YES; in which case read them 364 !! 365 IF(lwp) WRITE(numout,*) ' CFC averaged properties present - reading in ...' 366 CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 367 ELSE 368 !! NO; in which case set them to zero 369 !! 370 IF(lwp) WRITE(numout,*) ' CFC averaged properties absent - setting to zero ...' 371 qint_cfc(:,:,jn) = 0.0 !! CHN 372 ENDIF 373 !! 374 !! calculate stats on these fields 375 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 376 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 377 END DO 378 #endif 119 379 ! 120 380 END SUBROUTINE trc_rst_read … … 128 388 INTEGER, INTENT( in ) :: kt ! ocean time-step index 129 389 !! 130 INTEGER :: jn 390 INTEGER :: jn, jl 131 391 REAL(wp) :: zarak0 392 !! AXY (05/11/13): temporary variables 393 REAL(wp) :: fq0,fq1,fq2 132 394 !!---------------------------------------------------------------------- 133 395 ! … … 142 404 CALL iom_rstput( kt, nitrst, numrtw, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 143 405 END DO 144 ! 406 407 !! AXY (09/06/14): the ARCHER version of MEDUSA-2 does not include an equivalent 408 !! call to MEDUSA-2 at this point; this suggests that the FCM 409 !! version of NEMO date significantly earlier than the current 410 !! version 411 412 #if defined key_medusa 413 !! AXY (13/01/12): write out "before" and "now" state of seafloor 414 !! sediment pools into restart; this happens 415 !! whether or not the pools are to be used by 416 !! MEDUSA (which is controlled by a switch in the 417 !! namelist_top file) 418 !! 419 IF(lwp) WRITE(numout,*) ' MEDUSA sediment fields - writing out ...' 420 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_N', zb_sed_n(:,:) ) 421 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_N', zn_sed_n(:,:) ) 422 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_FE', zb_sed_fe(:,:) ) 423 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_FE', zn_sed_fe(:,:) ) 424 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_SI', zb_sed_si(:,:) ) 425 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_SI', zn_sed_si(:,:) ) 426 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_C', zb_sed_c(:,:) ) 427 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_C', zn_sed_c(:,:) ) 428 CALL iom_rstput( kt, nitrst, numrtw, 'B_SED_CA', zb_sed_ca(:,:) ) 429 CALL iom_rstput( kt, nitrst, numrtw, 'N_SED_CA', zn_sed_ca(:,:) ) 430 !! 431 !! calculate stats on these fields 432 IF(lwp) WRITE(numout,*) ' MEDUSA sediment field stats (min, max, sum) ...' 433 call trc_rst_dia_stat(zn_sed_n(:,:), 'Sediment N') 434 call trc_rst_dia_stat(zn_sed_fe(:,:), 'Sediment Fe') 435 call trc_rst_dia_stat(zn_sed_si(:,:), 'Sediment Si') 436 call trc_rst_dia_stat(zn_sed_c(:,:), 'Sediment C') 437 call trc_rst_dia_stat(zn_sed_ca(:,:), 'Sediment Ca') 438 !! 439 !! AXY (07/07/15): write out temporally averaged fields for DMS 440 !! calculations 441 !! 442 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS - writing out ...' 443 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHN', zb_dms_chn(:,:) ) 444 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHN', zn_dms_chn(:,:) ) 445 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_CHD', zb_dms_chd(:,:) ) 446 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_CHD', zn_dms_chd(:,:) ) 447 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_MLD', zb_dms_mld(:,:) ) 448 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_MLD', zn_dms_mld(:,:) ) 449 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_QSR', zb_dms_qsr(:,:) ) 450 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_QSR', zn_dms_qsr(:,:) ) 451 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_DIN', zb_dms_din(:,:) ) 452 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_DIN', zn_dms_din(:,:) ) 453 !! JPALM 14-06-2016 -- add CO2 flux and DMS surf through the restart 454 !! -- needed for the coupling with atm 455 CALL iom_rstput( kt, nitrst, numrtw, 'B_DMS_srf', zb_dms_srf(:,:) ) 456 CALL iom_rstput( kt, nitrst, numrtw, 'N_DMS_srf', zn_dms_srf(:,:) ) 457 CALL iom_rstput( kt, nitrst, numrtw, 'B_CO2_flx', zb_co2_flx(:,:) ) 458 CALL iom_rstput( kt, nitrst, numrtw, 'N_CO2_flx', zn_co2_flx(:,:) ) 459 CALL iom_rstput( kt, nitrst, numrtw, 'N_CHL_srf', zn_chl_srf(:,:) ) 460 !! 461 !! calculate stats on these fields 462 IF(lwp) WRITE(numout,*) ' MEDUSA averaged properties for DMS stats (min, max, sum) ...' 463 call trc_rst_dia_stat(zn_dms_chn(:,:), 'DMS, CHN') 464 call trc_rst_dia_stat(zn_dms_chd(:,:), 'DMS, CHD') 465 call trc_rst_dia_stat(zn_dms_mld(:,:), 'DMS, MLD') 466 call trc_rst_dia_stat(zn_dms_qsr(:,:), 'DMS, QSR') 467 call trc_rst_dia_stat(zn_dms_din(:,:), 'DMS, DIN') 468 call trc_rst_dia_stat(zn_dms_srf(:,:), 'DMS surf') 469 call trc_rst_dia_stat(zn_co2_flx(:,:), 'CO2 flux') 470 call trc_rst_dia_stat(zn_chl_srf(:,:), 'CHL surf') 471 !! 472 IF(lwp) WRITE(numout,*) ' MEDUSA averaged prop. for dust and iron dep.' 473 call trc_rst_dia_stat(dust(:,:), 'Dust dep') 474 call trc_rst_dia_stat(zirondep(:,:), 'Iron dep') 475 !! 476 !! 477 !! JPALM 14-06-2016 -- add Carbonate chenistry variables through the restart 478 !! -- needed for monthly call of carb-chem routine and better reproducibility 479 # if defined key_roam 480 IF(lwp) WRITE(numout,*) 'Carbonate chem variable - writing out ...' 481 CALL iom_rstput( kt, nitrst, numrtw, 'pH_3D' , f3_pH(:,:,:) ) 482 CALL iom_rstput( kt, nitrst, numrtw, 'h2CO3_3D', f3_h2co3(:,:,:) ) 483 CALL iom_rstput( kt, nitrst, numrtw, 'hCO3_3D' , f3_hco3(:,:,:) ) 484 CALL iom_rstput( kt, nitrst, numrtw, 'CO3_3D' , f3_co3(:,:,:) ) 485 CALL iom_rstput( kt, nitrst, numrtw, 'omcal_3D', f3_omcal(:,:,:) ) 486 CALL iom_rstput( kt, nitrst, numrtw, 'omarg_3D', f3_omarg(:,:,:) ) 487 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_CAL' , f2_ccd_cal(:,:) ) 488 CALL iom_rstput( kt, nitrst, numrtw, 'CCD_ARG' , f2_ccd_arg(:,:) ) 489 !! 490 IF(lwp) WRITE(numout,*) ' MEDUSA averaged Carb-chem stats (min, max, sum) ...' 491 call trc_rst_dia_stat( f3_pH(:,:,1) ,'pH 3D surf') 492 call trc_rst_dia_stat( f3_h2co3(:,:,1),'h2CO3 3D surf') 493 call trc_rst_dia_stat( f3_hco3(:,:,1) ,'hCO3 3D surf' ) 494 call trc_rst_dia_stat( f3_co3(:,:,1) ,'CO3 3D surf' ) 495 call trc_rst_dia_stat( f3_omcal(:,:,1),'omcal 3D surf') 496 call trc_rst_dia_stat( f3_omarg(:,:,1),'omarg 3D surf') 497 call trc_rst_dia_stat( f2_ccd_cal(:,:),'CCD_CAL') 498 call trc_rst_dia_stat( f2_ccd_arg(:,:),'CCD_ARG') 499 !! 500 # endif 501 !! 502 #endif 503 ! 504 #if defined key_idtra 505 !! JPALM -- 05-01-2016 -- mv idtra and CFC restart reading and 506 !! writting here undre their key. 507 !! problems in CFC restart, maybe because of this... 508 !! and pb in idtra diag or diad-restart writing. 509 !!---------------------------------------------------------------------- 510 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties - writing out ...' 511 CALL iom_rstput( kt, nitrst, numrtw, 'qint_IDTRA', qint_idtra(:,:,1) ) 512 !! 513 !! calculate stats on these fields 514 IF(lwp) WRITE(numout,*) ' IDTRA averaged properties stats (min, max, sum) ...' 515 call trc_rst_dia_stat(qint_idtra(:,:,1), 'qint_IDTRA') 516 #endif 517 ! 518 #if defined key_cfc 519 DO jl = 1, jp_cfc 520 jn = jp_cfc0 + jl - 1 521 IF(lwp) WRITE(numout,*) ' CFC averaged properties - writing out ...' 522 CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) ) 523 !! 524 !! calculate stats on these fields 525 IF(lwp) WRITE(numout,*) ' CFC averaged properties stats (min, max, sum) ...' 526 call trc_rst_dia_stat(qint_cfc(:,:,jl), 'qint_'//ctrcnm(jn)) 527 END DO 528 #endif 529 ! 530 145 531 IF( kt == nitrst ) THEN 146 532 CALL trc_rst_stat ! statistics … … 304 690 IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 305 691 END DO 306 WRITE(numout,*)692 IF(lwp) WRITE(numout,*) 307 693 9000 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 308 694 & ' max :',e18.10,' drift :',e18.10, ' %') 309 695 ! 310 696 END SUBROUTINE trc_rst_stat 697 698 699 SUBROUTINE trc_rst_tra_stat 700 !!---------------------------------------------------------------------- 701 !! *** trc_rst_tra_stat *** 702 !! 703 !! ** purpose : Compute tracers statistics - check where crazy values appears 704 !!---------------------------------------------------------------------- 705 INTEGER :: jk, jn 706 REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift, areasf 707 REAL(wp), DIMENSION(jpi,jpj) :: zvol 708 !!---------------------------------------------------------------------- 709 710 IF( lwp ) THEN 711 WRITE(numout,*) 712 WRITE(numout,*) ' ----SURFACE TRA STAT---- ' 713 WRITE(numout,*) 714 ENDIF 715 ! 716 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 717 areasf = glob_sum(zvol(:,:)) 718 DO jn = 1, jptra 719 ztraf = glob_sum( tra(:,:,1,jn) * zvol(:,:) ) 720 zmin = MINVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 721 zmax = MAXVAL( tra(:,:,1,jn), mask= ((tmask(:,:,1).NE.0.)) ) 722 IF( lk_mpp ) THEN 723 CALL mpp_min( zmin ) ! min over the global domain 724 CALL mpp_max( zmax ) ! max over the global domain 725 END IF 726 zmean = ztraf / areasf 727 IF(lwp) WRITE(numout,9001) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax 728 END DO 729 IF(lwp) WRITE(numout,*) 730 9001 FORMAT(' tracer nb :',i2,' name :',a10,' mean :',e18.10,' min :',e18.10, & 731 & ' max :',e18.10) 732 ! 733 END SUBROUTINE trc_rst_tra_stat 734 735 736 737 SUBROUTINE trc_rst_dia_stat( dgtr, names) 738 !!---------------------------------------------------------------------- 739 !! *** trc_rst_dia_stat *** 740 !! 741 !! ** purpose : Compute tracers statistics 742 !!---------------------------------------------------------------------- 743 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: dgtr ! 2D diag var 744 CHARACTER(len=*) , INTENT(in) :: names ! 2D diag name 745 !!--------------------------------------------------------------------- 746 INTEGER :: jk, jn 747 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 748 REAL(wp), DIMENSION(jpi,jpj) :: zvol 749 !!---------------------------------------------------------------------- 750 751 IF( lwp ) WRITE(numout,*) 'STAT- ', names 752 ! 753 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 754 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) 755 !! areasf = glob_sum(e1e2t(:,:) * tmask(:,:,1) ) 756 areasf = glob_sum(zvol(:,:)) 757 zmin = MINVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 758 zmax = MAXVAL( dgtr(:,:), mask= ((tmask(:,:,1).NE.0.)) ) 759 IF( lk_mpp ) THEN 760 CALL mpp_min( zmin ) ! min over the global domain 761 CALL mpp_max( zmax ) ! max over the global domain 762 END IF 763 zmean = ztraf / areasf 764 IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 765 ! 766 IF(lwp) WRITE(numout,*) 767 9002 FORMAT(' tracer name :',a10,' mean :',e18.10,' min :',e18.10, & 768 & ' max :',e18.10 ) 769 ! 770 END SUBROUTINE trc_rst_dia_stat 771 311 772 312 773 #else -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r7203 r8280 16 16 USE trc ! 17 17 USE trcsms_pisces ! PISCES biogeo-model 18 USE trcsms_medusa ! MEDUSA tracers 19 USE trcsms_idtra ! Idealize Tracer 18 20 USE trcsms_cfc ! CFC 11 & 12 19 21 USE trcsms_c14b ! C14b tracer 22 USE trcsms_age ! AGE tracer 20 23 USE trcsms_my_trc ! MY_TRC tracers 21 24 USE prtctl_trc ! Print control for debbuging … … 43 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 44 47 !! 48 INTEGER :: jn 45 49 CHARACTER (len=25) :: charout 46 50 !!--------------------------------------------------------------------- … … 49 53 ! 50 54 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 55 IF( lk_medusa ) CALL trc_sms_medusa ( kt ) ! MEDUSA tracers 56 # if defined key_debug_medusa 57 IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK -- next IDTRA -- ' 58 CALL flush(numout) 59 # endif 60 IF( lk_idtra ) CALL trc_sms_idtra ( kt ) ! radioactive decay of Id. tracer 61 # if defined key_debug_medusa 62 IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK -- next CFC -- ' 63 CALL flush(numout) 64 # endif 51 65 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 66 # if defined key_debug_medusa 67 IF(lwp) WRITE(numout,*) '--trcsms : CFC OK -- next C14 -- ' 68 CALL flush(numout) 69 # endif 52 70 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 71 # if defined key_debug_medusa 72 IF(lwp) WRITE(numout,*) '--trcsms : C14 OK -- next C14 -- ' 73 CALL flush(numout) 74 # endif 75 IF( lk_age ) CALL trc_sms_age ( kt ) ! AGE tracer 76 # if defined key_debug_medusa 77 IF(lwp) WRITE(numout,*) '--trcsms : Age OK -- Continue -- ' 78 CALL flush(numout) 79 # endif 53 80 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 54 81 -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r6487 r8280 55 55 !! Update the passive tracers 56 56 !!------------------------------------------------------------------- 57 58 USE dom_oce, ONLY: narea 59 57 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 58 61 INTEGER :: jk, jn ! dummy loop indices … … 87 90 tra(:,:,:,:) = 0.e0 88 91 ! 92 # if defined key_debug_medusa 93 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt 94 CALL flush(numout) 95 # endif 89 96 CALL trc_rst_opn ( kt ) ! Open tracer restart file 97 # if defined key_debug_medusa 98 CALL trc_rst_stat 99 CALL trc_rst_tra_stat 100 # endif 90 101 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 91 102 IF( lk_iomput ) THEN ; CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager … … 93 104 ENDIF 94 105 CALL trc_sms ( kt ) ! tracers: sinks and sources 106 # if defined key_debug_medusa 107 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp SMS complete at kt =', kt 108 CALL trc_rst_stat 109 CALL trc_rst_tra_stat 110 CALL flush(numout) 111 # endif 95 112 CALL trc_trp ( kt ) ! transport of passive tracers 113 # if defined key_debug_medusa 114 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp transport complete at kt =', kt 115 CALL trc_rst_stat 116 CALL trc_rst_tra_stat 117 CALL flush(numout) 118 # endif 96 119 IF( kt == nittrc000 ) THEN 97 120 CALL iom_close( numrtr ) ! close input tracer restart file … … 102 125 ! 103 126 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 104 ! 105 ENDIF 106 ! 107 ztrai = 0._wp ! content of all tracers 108 DO jn = 1, jptra 109 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 110 END DO 111 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 112 9300 FORMAT(i10,e18.10) 127 # if defined key_debug_medusa 128 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt 129 CALL flush(numout) 130 # endif 131 ! 132 ENDIF 133 ! 134 IF (ln_ctl) THEN 135 ! The following code is very expensive since it involves multiple 136 ! reproducible global sums over all tracer fields and is potentially 137 ! called on every timestep. The results it produces are purely for 138 ! informational purposes and do not affect model evolution. 139 ! Hence we restrict its use by protecting it with the ln_ctl RTL 140 ! which should normally only be used under debugging conditions 141 ! and not in operational runs. We also need to restrict output 142 ! to the master PE since there's no point duplicating the same results 143 ! on all processors. 144 ztrai = 0._wp ! content of all tracers 145 DO jn = 1, jptra 146 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 147 END DO 148 IF( numstr /= -1 ) WRITE(numstr,9300) kt, ztrai / areatot 149 9300 FORMAT(i10,e18.10) 150 ENDIF 113 151 ! 114 152 IF( nn_timing == 1 ) CALL timing_stop('trc_stp') -
branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r7203 r8280 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2009-05 (C. Ethe) Original code 7 !! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2 7 8 !!---------------------------------------------------------------------- 8 9 #if defined key_top && defined key_iomput … … 21 22 USE trcwri_c14b 22 23 USE trcwri_my_trc 24 USE trcwri_medusa 25 USE trcwri_idtra 26 USE trcwri_age 23 27 24 28 IMPLICIT NONE … … 57 61 ! --------------------------------------- 58 62 IF( lk_pisces ) CALL trc_wri_pisces ! PISCES 63 IF( lk_medusa ) CALL trc_wri_medusa ! MESDUSA 64 IF( lk_idtra ) CALL trc_wri_idtra ! Idealize tracers 59 65 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 60 66 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 67 IF( lk_age ) CALL trc_wri_age ! AGE tracer 61 68 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 62 69 !
Note: See TracChangeset
for help on using the changeset viewer.