Changeset 1884
- Timestamp:
- 2010-05-27T11:26:52+02:00 (14 years ago)
- Location:
- branches/TAM_V3_0/NEMO/OPA_SRC
- Files:
-
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/TAM_V3_0/NEMO/OPA_SRC/DTA/dtasal.F90
r1152 r1884 34 34 INTEGER :: & 35 35 numsdt, & !: logical unit for data salinity 36 #if defined key_pomme_r025 37 nsal1, nsal2 , & ! first and second record used 38 nlecsa = 0 ! flag for first read 39 #else 36 40 nsal1, nsal2 ! first and second record used 41 #endif 37 42 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 38 43 saldta ! salinity data at two consecutive times … … 89 94 REAL(wp) :: zfac 90 95 #endif 96 CHARACTER (len=38) :: & 97 cl_sdata = 'data_1m_salinity_nomask ' 91 98 REAL(wp), DIMENSION(jpk,2) :: & 92 99 zsaldta ! auxiliary array for interpolation … … 96 103 ! ----------------- 97 104 98 iman = INT( raamo ) 105 #if defined key_pomme_r025 106 ! DRAKKAR : we use input file with 1 month only 107 iman = 1 108 #else 109 iman = INT( raamo ) 110 #endif 111 99 112 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 100 113 i15 = nday / 16 … … 109 122 nsal1 = 0 ! initializations 110 123 IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 111 CALL iom_open ( 'data_1m_salinity_nomask', numsdt )112 124 CALL iom_open ( cl_sdata, numsdt ) 125 113 126 ENDIF 114 127 … … 117 130 ! ------------------- 118 131 132 #if defined key_pomme_r025 133 ! IF( kt == nit000 .OR. imois /= nsal1 ) THEN 134 ! In standard ORCA025, no damping is done. We read Levitus only for initial condition 135 IF( kt == nit000 .AND. nlecsa == 0 ) THEN 136 nlecsa = 1 137 #else 119 138 IF( kt == nit000 .OR. imois /= nsal1 ) THEN 139 #endif 120 140 121 141 ! 2.1 Calendar computation … … 318 338 CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 319 339 ENDIF 340 #if ! defined key_pomme_r025 320 341 ENDIF 342 #endif 321 343 322 344 … … 326 348 zxy = FLOAT(nday + 15 - 30*i15)/30. 327 349 s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 350 351 #if defined key_pomme_r025 352 ENDIF 353 #endif 328 354 329 355 ! Close the file -
branches/TAM_V3_0/NEMO/OPA_SRC/DTA/dtatem.F90
r1152 r1884 33 33 INTEGER :: & 34 34 numtdt, & !: logical unit for data temperature 35 #if defined key_pomme_r025 36 ntem1, ntem2 , & ! first and second record used 37 nlecte = 0 ! switch for frist read 38 #else 35 39 ntem1, ntem2 ! first and second record used 40 #endif 36 41 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 37 42 temdta ! temperature data at two consecutive times … … 94 99 REAL(wp) :: zfac 95 100 #endif 101 CHARACTER (len=38) :: & 102 cl_tdata = 'data_1m_potential_temperature_nomask ' 96 103 REAL(wp), DIMENSION(jpk,2) :: & 97 104 ztemdta ! auxiliary array for interpolation … … 101 108 ! ----------------- 102 109 110 #if defined key_pomme_r025 111 ! DRAKKAR : we use input file with 1 month only 112 iman = 1 113 #else 103 114 iman = INT( raamo ) 115 #endif 104 116 !!! better but change the results i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 105 117 i15 = nday / 16 … … 114 126 ntem1= 0 ! initializations 115 127 IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 116 CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt )128 CALL iom_open ( cl_tdata, numtdt ) 117 129 118 130 ENDIF … … 122 134 ! ------------------- 123 135 136 #if defined key_pomme_r025 137 ! DRAKKAR read only first step 138 ! IF( kt == nit000 .OR. imois /= ntem1 ) THEN 139 IF( kt == nit000 .AND. nlecte == 0 ) THEN 140 nlecte = 1 141 #else 124 142 IF( kt == nit000 .OR. imois /= ntem1 ) THEN 143 #endif 125 144 126 145 ! Calendar computation … … 314 333 CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 315 334 ENDIF 335 #if ! defined key_pomme_r025 316 336 ENDIF 337 #endif 317 338 318 339 … … 322 343 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 323 344 t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 324 345 346 #if defined key_pomme_r025 347 ENDIF 348 #endif 349 325 350 ! Close the file 326 351 ! -------------- -
branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynadv.F90
r1152 r1884 23 23 24 24 PUBLIC dyn_adv ! routine called by step module 25 PUBLIC dyn_adv_ctl ! routine called by dyn_adv_tam module 25 26 26 27 LOGICAL, PUBLIC :: ln_dynadv_vec = .TRUE. ! vector form flag -
branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynspg.F90
r1152 r1884 70 70 CASE ( 2 ) ; CALL dyn_spg_flt ( kt, kindic ) ! filtered 71 71 CASE ( 3 ) ; CALL dyn_spg_rl ( kt, kindic ) ! rigid lid 72 ! 72 ! 73 73 CASE ( -1 ) ! esopa: test all possibility with control print 74 ;CALL dyn_spg_exp ( kt )75 ;CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, &74 CALL dyn_spg_exp ( kt ) 75 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg0 - Ua: ', mask1=umask, & 76 76 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 77 ;CALL dyn_spg_ts ( kt )78 ;CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, &77 CALL dyn_spg_ts ( kt ) 78 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg1 - Ua: ', mask1=umask, & 79 79 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 80 ;CALL dyn_spg_flt ( kt, kindic )81 ;CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, &80 CALL dyn_spg_flt ( kt, kindic ) 81 CALL prt_ctl( tab3d_1=ua, clinfo1=' spg2 - Ua: ', mask1=umask, & 82 82 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 83 83 END SELECT -
branches/TAM_V3_0/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r1200 r1884 252 252 #if defined key_obc 253 253 CALL obc_dyn( kt ) ! Update velocities on each open boundary with the radiation algorithm 254 CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system 254 # if defined key_pomme_r025 255 IF( nbit_cmp == 0 ) CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system 256 # else 257 CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system 258 # endif 255 259 #endif 256 260 #if defined key_bdy -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obc_oce.F90
r1158 r1884 60 60 ! ! scale are set to 0 in the namelist, for both inflow and outflow). 61 61 62 #if defined key_pomme_r025 63 ! Logical for restarting with radiative OBCs, but without an OBC restart restart.obc.output file. 64 ! During the first 30 time steps, used FIXED boundary conditions. 65 ! We modify : obcini, obctra, obcdyn 66 LOGICAL :: ln_obc_rstart = .FALSE. !: radiative OBCs, but do not read restart.obc.output 67 62 68 REAL(wp), PUBLIC :: & !: 63 obcsurftot !: Total lateral surface of open boundaries 69 ! Add computation of E/W/N/S lateral surface of open boundaries 70 obcsurftot , & !: Total lateral surface of open boundaries 71 obcsurfeast , & !: East lateral surface of open boundaries 72 obcsurfwest , & !: West lateral surface of open boundaries 73 obcsurfnorth , & !: North lateral surface of open boundaries 74 obcsurfsouth !: South lateral surface of open boundaries 75 #endif 76 77 ! REAL(wp), PUBLIC :: & !: 78 ! obcsurftot !: Total lateral surface of open boundaries 64 79 65 80 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & !: -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obc_par.F90
r1152 r1884 32 32 !!---------------------------------------------------------------------- 33 33 # include "obc_par_EEL_R5.h90" 34 35 # elif defined key_pomme_r025 36 !!---------------------------------------------------------------------- 37 !! 'key_pomme_r025' : POMME R025 configuration 38 !!---------------------------------------------------------------------- 39 # include "obc_par_POMME_R025.h90" 34 40 35 41 # else -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcdta.F90
r1156 r1884 63 63 LOGICAL, DIMENSION (jpi,jpk ) :: ltnmsk=.TRUE., lunmsk=.TRUE., lvnmsk=.TRUE. ! checks 64 64 LOGICAL, DIMENSION (jpi,jpk ) :: ltsmsk=.TRUE., lusmsk=.TRUE., lvsmsk=.TRUE. 65 66 LOGICAL :: ln_obc_tangential=.FALSE. 65 67 66 68 !! * Substitutions … … 829 831 IF( imois == 0 ) imois = iman 830 832 itimo = imois 833 #if defined key_pomme_r025 834 ELSE IF ( ntobc == 14 ) THEN 835 i15 = nday / 16 836 imois = nmonth + i15 - 1 837 itimo = imois + 1 ! shift 838 #endif 831 839 ELSE 832 840 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt … … 1191 1199 CALL iom_close ( id_e ) 1192 1200 ! 1193 CALL iom_open ( cl_obc_eV , id_e ) 1194 CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 1195 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1196 CALL iom_close ( id_e ) 1201 1202 IF ( ln_obc_tangential ) THEN 1203 CALL iom_open ( cl_obc_eV , id_e ) 1204 CALL iom_get ( id_e, jpdom_unknown, 'vomecrty', vedta(nje0:nje1,:,nt_x), & 1205 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1206 CALL iom_close ( id_e ) 1207 ENDIF 1197 1208 1198 1209 ! mask the boundary values … … 1261 1272 CALL iom_close ( id_w ) 1262 1273 ! 1263 CALL iom_open ( cl_obc_wV , id_w ) 1264 CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 1265 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1266 CALL iom_close ( id_w ) 1274 IF ( ln_obc_tangential ) THEN 1275 CALL iom_open ( cl_obc_wV , id_w ) 1276 CALL iom_get ( id_w, jpdom_unknown, 'vomecrty', vwdta(njw0:njw1,:,nt_x), & 1277 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1278 CALL iom_close ( id_w ) 1279 ENDIF 1267 1280 1268 1281 ! mask the boundary values … … 1322 1335 CALL iom_close (id_n) 1323 1336 ! 1324 CALL iom_open ( cl_obc_nU , id_n ) 1325 CALL iom_get ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 1326 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1327 CALL iom_close ( id_n ) 1337 IF ( ln_obc_tangential ) THEN 1338 CALL iom_open ( cl_obc_nU , id_n ) 1339 CALL iom_get ( id_n, jpdom_unknown, 'vozocrtx', undta(nin0:nin1,:,nt_x), & 1340 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1341 CALL iom_close ( id_n ) 1342 ENDIF 1328 1343 ! 1329 1344 CALL iom_open ( cl_obc_nV , id_n ) … … 1387 1402 CALL iom_close (id_s) 1388 1403 ! 1389 CALL iom_open ( cl_obc_sU , id_s ) 1390 CALL iom_get ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 1391 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1392 CALL iom_close ( id_s ) 1404 IF ( ln_obc_tangential ) THEN 1405 CALL iom_open ( cl_obc_sU , id_s ) 1406 CALL iom_get ( id_s, jpdom_unknown, 'vozocrtx', usdta(nis0:nis1,:,nt_x), & 1407 & ktime=ntobc_x , kstart=istart, kcount= icount ) 1408 CALL iom_close ( id_s ) 1409 ENDIF 1393 1410 ! 1394 1411 CALL iom_open ( cl_obc_sV , id_s ) -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcdyn.F90
r1152 r1884 47 47 REAL(wp) :: rtaue , rtauw , rtaun , rtaus , & 48 48 rtauein, rtauwin, rtaunin, rtausin 49 50 LOGICAL :: ll_fbc 49 51 50 52 !!--------------------------------------------------------------------------------- … … 102 104 END IF 103 105 104 IF( lp_obc_east ) CALL obc_dyn_east ( kt ) 105 IF( lp_obc_west ) CALL obc_dyn_west ( kt ) 106 IF( lp_obc_north ) CALL obc_dyn_north( kt ) 107 IF( lp_obc_south ) CALL obc_dyn_south( kt ) 106 ll_fbc = ( ( ( kt < nit000+3 ) .AND. .NOT. ln_rstart ) .OR. lk_dynspg_exp ) 107 108 IF ( cp_cfg == "indian" ) THEN 109 ll_fbc = ( ( ( kt < nit000+30 ) .AND. .NOT. ln_obc_rstart ) .OR. lk_dynspg_exp ) 110 ENDIF 111 112 IF( lp_obc_east ) CALL obc_dyn_east !( kt ) 113 IF( lp_obc_west ) CALL obc_dyn_west !( kt ) 114 IF( lp_obc_north ) CALL obc_dyn_north!( kt ) 115 IF( lp_obc_south ) CALL obc_dyn_south!( kt ) 108 116 109 117 IF( lk_mpp ) THEN … … 119 127 120 128 121 SUBROUTINE obc_dyn_east ( kt )129 SUBROUTINE obc_dyn_east 122 130 !!------------------------------------------------------------------------------ 123 131 !! *** SUBROUTINE obc_dyn_east *** … … 137 145 !!------------------------------------------------------------------------------ 138 146 !! * Arguments 139 INTEGER, INTENT( in ) :: kt140 147 141 148 !! * Local declaration … … 147 154 ! -------------------------------------------------------- 148 155 149 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp) THEN156 IF ( ll_fbc .OR. lfbceast ) THEN 150 157 151 158 ! 1.1 U zonal velocity … … 282 289 283 290 284 SUBROUTINE obc_dyn_west ( kt )291 SUBROUTINE obc_dyn_west 285 292 !!------------------------------------------------------------------------------ 286 293 !! *** SUBROUTINE obc_dyn_west *** … … 300 307 !!------------------------------------------------------------------------------ 301 308 !! * Arguments 302 INTEGER, INTENT( in ) :: kt303 309 304 310 !! * Local declaration … … 310 316 ! -------------------------------------------------------- 311 317 312 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp) THEN318 IF ( ll_fbc .OR. lfbcwest ) THEN 313 319 314 320 ! 1.1 U zonal velocity … … 443 449 END SUBROUTINE obc_dyn_west 444 450 445 SUBROUTINE obc_dyn_north ( kt )451 SUBROUTINE obc_dyn_north 446 452 !!------------------------------------------------------------------------------ 447 453 !! SUBROUTINE obc_dyn_north … … 461 467 !!------------------------------------------------------------------------------ 462 468 !! * Arguments 463 INTEGER, INTENT( in ) :: kt464 469 465 470 !! * Local declaration … … 471 476 ! --------------------------------------------------------- 472 477 473 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth .OR. lk_dynspg_exp) THEN474 478 IF ( ll_fbc .OR. lfbcnorth ) THEN 479 475 480 ! 1.1 U zonal velocity 476 481 ! -------------------- … … 611 616 END DO 612 617 # endif 618 619 613 620 END IF 614 621 615 622 END SUBROUTINE obc_dyn_north 616 623 617 SUBROUTINE obc_dyn_south ( kt )624 SUBROUTINE obc_dyn_south 618 625 !!------------------------------------------------------------------------------ 619 626 !! SUBROUTINE obc_dyn_south … … 633 640 !!------------------------------------------------------------------------------ 634 641 !! * Arguments 635 INTEGER, INTENT( in ) :: kt636 642 637 643 !! * Local declaration … … 646 652 ! --------------------------------------------------------- 647 653 648 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth .OR. lk_dynspg_exp) THEN649 654 IF ( ll_fbc .OR. lfbcsouth ) THEN 655 650 656 ! 1.1 U zonal velocity 651 657 ! -------------------- -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obcini.F90
r1152 r1884 19 19 USE in_out_manager ! I/O units 20 20 USE dynspg_oce ! flag lk_dynspg_flt 21 #if defined key_pomme_r025 22 USE iom 23 #endif 21 24 22 25 IMPLICIT NONE … … 64 67 !! * Local declarations 65 68 INTEGER :: ji, jj, istop , inumfbc 69 #if defined key_pomme_r025 70 INTEGER inum0 71 #endif 66 72 INTEGER, DIMENSION(4) :: icorner 67 73 REAL(wp) :: zbsic1, zbsic2, zbsic3 … … 111 117 IF(lwp) WRITE(numout,*) ' Number of open boundaries nbobc = ',nbobc 112 118 IF(lwp) WRITE(numout,*) 113 IF( nbobc /= 0.AND. jperio /= 0 ) &119 IF( nbobc >= 2 .AND. jperio /= 0 ) & 114 120 & CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 115 121 … … 433 439 ENDIF 434 440 441 #if defined key_pomme_r025 442 443 IF ( nmsh == 1 ) THEN 444 WRITE(numout,*) 'obc_init : appending obc masks in mesh_mask.nc' 445 CALL iom_open( 'mesh_mask_obc.nc', inum0, ldwrt = .TRUE., kiolib = jprstlib ) 446 CALL iom_rstput( 0, 0, inum0, 'obctmsk', obctmsk ) 447 CALL iom_rstput( 0, 0, inum0, 'obcumask', obcumask ) 448 CALL iom_rstput( 0, 0, inum0, 'obcvmask', obcvmask ) 449 CALL iom_close(inum0) 450 ENDIF 451 #endif 452 435 453 IF (lk_dynspg_rl ) THEN 436 454 ! do nothing particular … … 441 459 ! 3.1 Total lateral surface 442 460 ! ------------------------- 443 obcsurftot = 0.e0 461 462 463 MPI_CHK : IF ( nbit_cmp == 1 ) THEN 464 465 IF( ( lp_obc_west .AND. lp_obc_west_barotp_corr ) & 466 & .OR. ( lp_obc_east .AND. lp_obc_east_barotp_corr ) & 467 & .OR. ( lp_obc_north .AND. lp_obc_north_barotp_corr ) & 468 & .OR. ( lp_obc_south .AND. lp_obc_south_barotp_corr ) ) THEN 469 IF(lwp)WRITE(numout,cform_war) 470 IF(lwp)WRITE(numout,*) ' nbit_cmp = 1 => no barotropic redistribution along OBCs is enforced' 471 nwarn = nwarn + 1 472 ENDIF 473 474 ELSE 475 476 obcsurfeast = 0.e0 ; obcsurfwest = 0.e0 477 obcsurfnorth = 0.e0 ; obcsurfsouth = 0.e0 478 obcsurftot = 0.e0 444 479 445 IF( lp_obc_east ) THEN ! ... East open boundary lateral surface 446 DO ji = nie0, nie1 447 DO jj = 1, jpj 448 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 480 IF( lp_obc_east .AND. lp_obc_east_barotp_corr ) THEN ! ... East open boundary lateral surface 481 DO ji = nie0, nie1 482 DO jj = 1, jpj 483 obcsurfeast = obcsurfeast+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 484 END DO 449 485 END DO 450 END DO 451 END IF 452 453 IF( lp_obc_west ) THEN ! ... West open boundary lateral surface 454 DO ji = niw0, niw1 455 DO jj = 1, jpj 456 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 486 obcsurftot = obcsurftot + obcsurfeast 487 END IF 488 489 IF( lp_obc_west .AND. lp_obc_west_barotp_corr ) THEN ! ... West open boundary lateral surface 490 DO ji = niw0, niw1 491 DO jj = 1, jpj 492 obcsurfwest = obcsurfwest+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) * MAX(obctmsk(ji,jj),obctmsk(ji+1,jj) ) 493 END DO 457 494 END DO 458 END DO 459 END IF 460 461 IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 462 DO jj = njn0, njn1 463 DO ji = 1, jpi 464 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 495 obcsurftot = obcsurftot + obcsurfwest 496 END IF 497 498 IF( lp_obc_north .AND. lp_obc_north_barotp_corr ) THEN ! ... North open boundary lateral surface 499 DO jj = njn0, njn1 500 DO ji = 1, jpi 501 obcsurfnorth = obcsurfnorth+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 502 END DO 465 503 END DO 466 END DO 467 END IF 468 469 IF( lp_obc_south ) THEN ! ... South open boundary lateral surface 470 DO jj = njs0, njs1 471 DO ji = 1, jpi 472 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 504 obcsurftot = obcsurftot + obcsurfnorth 505 END IF 506 507 IF( lp_obc_south .AND. lp_obc_south_barotp_corr ) THEN ! ... South open boundary lateral surface 508 DO jj = njs0, njs1 509 DO ji = 1, jpi 510 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) * MAX(obctmsk(ji,jj),obctmsk(ji,jj+1) ) 511 END DO 473 512 END DO 474 END DO 475 END IF 476 477 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 513 obcsurftot = obcsurftot + obcsurfsouth 514 END IF 515 516 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 517 518 ENDIF MPI_CHK 519 478 520 ENDIF 479 ENDIF ! rigid lid 521 522 ENDIF ! rigid lid 480 523 481 524 ! 5. Control print on mask … … 603 646 ! -------------------------------------------------------------- 604 647 ! only if at least one boundary is radiative 605 IF ( inumfbc < nbobc .AND. ln_rstart ) THEN 606 ! Restart from restart.obc 607 CALL obc_rst_read 608 ELSE 648 649 ! Restart from restart.obc 650 651 !--> IND025 Begin 652 IF(lwp) WRITE(numout,*) 653 IF(lwp) WRITE(numout,*) ' obcini : ' 654 IF(lwp) WRITE(numout,*) ' ln_rstart : ', ln_rstart 655 IF(lwp) WRITE(numout,*) ' ln_obc_rstart : ', ln_obc_rstart 656 657 IF ( .NOT. ln_rstart .AND. ln_obc_rstart ) THEN 658 IF(lwp) WRITE(numout,*) ' obcini : Warning!! ln_rstart = .F. => we force ln_obc_rstart =.F. ' 659 ln_obc_rstart = .FALSE. 660 ENDIF 661 662 IF ( ln_rstart .AND. ln_obc_rstart ) THEN 663 IF ( inumfbc < nbobc ) THEN 664 IF(lwp) WRITE(numout,*) ' => We read the OBC restart file ' 665 CALL obc_rst_read 666 ELSE 667 IF(lwp) WRITE(numout,*) ' => We DO NOT read the OBC restart file (since all OBCs are fixed) ' 668 ENDIF 669 670 !<-- IND025 End 671 672 ELSE 609 673 610 674 ! ! ... Initialization to zero of radiation arrays. -
branches/TAM_V3_0/NEMO/OPA_SRC/OBC/obctra.F90
r1152 r1884 43 43 rtauein, rtauwin, rtaunin, rtausin ! Boundary restoring coefficient for inflow 44 44 45 LOGICAL :: ll_fbc 46 45 47 !! * Substitutions 46 48 # include "obc_vectopt_loop_substitute.h90" … … 91 93 END IF 92 94 93 IF( lp_obc_east ) CALL obc_tra_east ( kt ) ! East open boundary 94 95 IF( lp_obc_west ) CALL obc_tra_west ( kt ) ! West open boundary 96 97 IF( lp_obc_north ) CALL obc_tra_north( kt ) ! North open boundary 98 99 IF( lp_obc_south ) CALL obc_tra_south( kt ) ! South open boundary 95 ll_fbc = ( ( kt < nit000+3 ) .AND. .NOT. ln_rstart ) 96 97 IF ( cp_cfg == "indian" ) THEN 98 ll_fbc = ( ( kt < nit000+30 ) .AND. .NOT. ln_obc_rstart ) 99 ENDIF 100 101 IF( lp_obc_east ) CALL obc_tra_east ! East open boundary 102 103 IF( lp_obc_west ) CALL obc_tra_west ! West open boundary 104 105 IF( lp_obc_north ) CALL obc_tra_north ! North open boundary 106 107 IF( lp_obc_south ) CALL obc_tra_south ! South open boundary 108 100 109 101 110 IF( lk_mpp ) THEN !!bug ??? … … 111 120 112 121 113 SUBROUTINE obc_tra_east ( kt )122 SUBROUTINE obc_tra_east 114 123 !!------------------------------------------------------------------------------ 115 124 !! *** SUBROUTINE obc_tra_east *** … … 128 137 !!------------------------------------------------------------------------------ 129 138 !! * Arguments 130 INTEGER, INTENT( in ) :: kt131 139 132 140 !! * Local declaration … … 139 147 ! -------------------------------------------------------- 140 148 141 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN 142 DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 149 IF ( ll_fbc .OR. lfbceast ) THEN 150 151 DO ji = fs_nie0+1, fs_nie1+1 ! Vector opt. 143 152 DO jk = 1, jpkm1 144 153 DO jj = 1, jpj … … 211 220 212 221 213 SUBROUTINE obc_tra_west ( kt )222 SUBROUTINE obc_tra_west 214 223 !!------------------------------------------------------------------------------ 215 224 !! *** SUBROUTINE obc_tra_west *** … … 228 237 !!------------------------------------------------------------------------------ 229 238 !! * Arguments 230 INTEGER, INTENT( in ) :: kt231 239 232 240 !! * Local declaration … … 239 247 ! -------------------------------------------------------- 240 248 241 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ).OR. lfbcwest ) THEN249 IF ( ll_fbc .OR. lfbcwest ) THEN 242 250 243 251 DO ji = fs_niw0, fs_niw1 ! Vector opt. … … 310 318 311 319 312 SUBROUTINE obc_tra_north ( kt )320 SUBROUTINE obc_tra_north 313 321 !!------------------------------------------------------------------------------ 314 322 !! *** SUBROUTINE obc_tra_north *** … … 327 335 !!------------------------------------------------------------------------------ 328 336 !! * Arguments 329 INTEGER, INTENT( in ) :: kt330 337 331 338 !! * Local declaration … … 338 345 ! -------------------------------------------------------- 339 346 340 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ).OR. lfbcnorth ) THEN347 IF ( ll_fbc .OR. lfbcnorth ) THEN 341 348 342 349 DO jj = fs_njn0+1, fs_njn1+1 ! Vector opt. … … 412 419 413 420 414 SUBROUTINE obc_tra_south ( kt )421 SUBROUTINE obc_tra_south 415 422 !!------------------------------------------------------------------------------ 416 423 !! *** SUBROUTINE obc_tra_south *** … … 429 436 !!------------------------------------------------------------------------------ 430 437 !! * Arguments 431 INTEGER, INTENT( in ) :: kt432 438 433 439 !! * Local declaration … … 440 446 ! -------------------------------------------------------- 441 447 442 IF ( ( kt < nit000+3 .AND. .NOT.ln_rstart ).OR. lfbcsouth ) THEN448 IF ( ll_fbc .OR. lfbcsouth ) THEN 443 449 444 450 DO jj = fs_njs0, fs_njs1 ! Vector opt. -
branches/TAM_V3_0/NEMO/OPA_SRC/TRA/tradmp.F90
r1152 r1884 41 41 42 42 PUBLIC tra_dmp ! routine called by step.F90 43 PUBLIC cofdis, dtacof, dtacof_zoom 43 44 44 45 #if ! defined key_agrif -
branches/TAM_V3_0/NEMO/OPA_SRC/TRA/traqsr.F90
r1146 r1884 38 38 LOGICAL , PUBLIC :: ln_qsr_sms = .false. ! flag to use or not the biological fluxes for light 39 39 40 INTEGER :: nksr ! number of levels41 REAL(wp), DIMENSION(jpk) :: gdsr ! profile of the solar flux penetration40 INTEGER , PUBLIC :: nksr ! number of levels 41 REAL(wp), DIMENSION(jpk) , PUBLIC :: gdsr ! profile of the solar flux penetration 42 42 43 43 !! * Substitutions -
branches/TAM_V3_0/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r1156 r1884 169 169 DO jj = 2, jpjm1 170 170 DO ji = fs_2, fs_jpim1 ! vector opt. 171 #if defined key_vvl 171 172 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 173 #else 174 zvsfvvl = fsve3t(ji,jj,jk) 175 #endif 172 176 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 173 177 ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl ! now scale factor at T-point … … 182 186 DO jj = 2, jpjm1 183 187 DO ji = fs_2, fs_jpim1 ! vector opt. 188 #if defined key_vvl 184 189 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 190 #else 191 zvsfvvl = fsve3t(ji,jj,1) 192 #endif 185 193 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 186 194 zwi(ji,jj,1) = 0.e0 … … 227 235 DO jj = 2, jpjm1 228 236 DO ji = fs_2, fs_jpim1 237 #if defined key_vvl 229 238 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 239 #else 240 zvsfvvl = fsve3t(ji,jj,1) 241 #endif 230 242 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 231 243 ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,1) … … 236 248 DO jj = 2, jpjm1 237 249 DO ji = fs_2, fs_jpim1 250 #if defined key_vvl 238 251 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 252 #else 253 zvsfvvl = fsve3t(ji,jj,jk) 254 #endif 239 255 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 240 256 ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,jk) … … 271 287 DO jj = 2, jpjm1 272 288 DO ji = fs_2, fs_jpim1 ! vector opt. 289 #if defined key_vvl 273 290 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 291 #else 292 zvsfvvl = fsve3t(ji,jj,jk) 293 #endif 274 294 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 275 295 ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl ! now scale factor at T-point … … 284 304 DO jj = 2, jpjm1 285 305 DO ji = fs_2, fs_jpim1 ! vector opt. 306 #if defined key_vvl 286 307 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 308 #else 309 zvsfvvl = fsve3t(ji,jj,1) 310 #endif 287 311 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 288 312 zwi(ji,jj,1) = 0.e0 … … 328 352 DO jj = 2, jpjm1 329 353 DO ji = fs_2, fs_jpim1 354 #if defined key_vvl 330 355 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 356 #else 357 zvsfvvl = fsve3t(ji,jj,1) 358 #endif 331 359 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl ! before scale factor at T-point 332 360 ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,1) ! now scale factor at T-point … … 337 365 DO jj = 2, jpjm1 338 366 DO ji = fs_2, fs_jpim1 367 #if defined key_vvl 339 368 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 369 #else 370 zvsfvvl = fsve3t(ji,jj,jk) 371 #endif 340 372 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl ! before scale factor at T-point 341 373 ze3tn = ( 1. - znvvl ) + znvvl*fse3t(ji,jj,jk) ! now scale factor at T-point -
branches/TAM_V3_0/NEMO/OPA_SRC/ZDF/zdftke.F90
r1201 r1884 49 49 50 50 PUBLIC zdf_tke ! routine called in step module 51 PUBLIC tke_rst 51 52 52 53 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag -
branches/TAM_V3_0/NEMO/OPA_SRC/daymod.F90
r1192 r1884 38 38 PUBLIC day ! called by step.F90 39 39 PUBLIC day_init ! called by istate.F90 40 PUBLIC day_mth ! called by daymod_tam.F90 40 41 41 42 INTEGER , PUBLIC :: nyear !: current year -
branches/TAM_V3_0/NEMO/OPA_SRC/eosbn2.F90
r1146 r1884 55 55 REAL(wp), PUBLIC :: ralpha = 2.0e-4 !: thermal expension coeff. (linear equation of state) 56 56 REAL(wp), PUBLIC :: rbeta = 7.7e-4 !: saline expension coeff. (linear equation of state) 57 58 INTEGER, PUBLIC :: neos_init = 0 !: control flag for initialization 57 59 58 INTEGER :: neos_init = 0 !: control flag for initialization59 60 60 !! * Substitutions 61 61 # include "domzgr_substitute.h90" -
branches/TAM_V3_0/NEMO/OPA_SRC/geo2ocean.F90
r1152 r1884 3 3 !! *** MODULE geo2ocean *** 4 4 !! Ocean mesh : ??? 5 !!===================================================================== 5 !!====================================================================== 6 !! History : OPA ! 07-1996 (O. Marti) Original code 7 !! NEMO 1.0 ! 02-2008 (G. Madec) F90: Free form 8 !! 3.0 ! 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- … … 11 15 !! repere : old routine suppress it ??? 12 16 !!---------------------------------------------------------------------- 13 !! * Modules used14 17 USE dom_oce ! mesh and scale factors 15 18 USE phycst ! physical constants … … 18 21 19 22 IMPLICIT NONE 20 21 !! * Accessibility22 23 PRIVATE 23 PUBLIC rot_rep, repcmo, repere, geo2oce ! only rot_rep should be used 24 25 PUBLIC rot_rep, repcmo, repere, geo2oce, oce2geo ! only rot_rep should be used 24 26 ! repcmo and repere are keep only for compatibility. 25 27 ! they are only a useless overlay of rot_rep 26 27 !! * Module variables 28 PUBLIC obs_rot 29 28 30 REAL(wp), DIMENSION(jpi,jpj) :: & 29 31 gsint, gcost, & ! cos/sin between model grid lines and NP direction at T point … … 34 36 LOGICAL :: lmust_init = .TRUE. !: used to initialize the cos/sin variables (se above) 35 37 36 !! * Substitutions38 !! * Substitutions 37 39 # include "vectopt_loop_substitute.h90" 38 !!---------------------------------------------------------------------- -----------39 !! OPA 9.0 , LOCEAN-IPSL (2005)40 !! $Id$ 41 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt42 !!---------------------------------------------------------------------- -----------40 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 !!---------------------------------------------------------------------- 43 45 44 46 CONTAINS … … 54 56 !! ** Method : Initialization of arrays at the first call. 55 57 !! 56 !! ** Action : - px2 : first componante (defined at u point)58 !! ** Action : - px2 : first componante (defined at u point) 57 59 !! - py2 : second componante (defined at v point) 58 !! 59 !! History : 60 !! 7.0 ! 07-96 (O. Marti) Original code 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form 62 !!---------------------------------------------------------------------- 63 !! * Arguments 64 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 65 pxu1, pyu1, & ! geographic vector componantes at u-point 66 pxv1, pyv1 ! geographic vector componantes at v-point 67 REAL(wp), INTENT( out ), DIMENSION(jpi,jpj) :: & 68 px2, & ! i-componante (defined at u-point) 69 py2 ! j-componante (defined at v-point) 60 !!---------------------------------------------------------------------- 61 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxu1, pyu1 ! geographic vector componantes at u-point 62 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxv1, pyv1 ! geographic vector componantes at v-point 63 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 64 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 70 65 !!---------------------------------------------------------------------- 71 66 72 67 ! Change from geographic to stretched coordinate 73 68 ! ---------------------------------------------- 74 75 69 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 76 70 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) … … 90 84 !! (O. Marti ) Original code (repere and repcmo) 91 85 !!---------------------------------------------------------------------- 92 !! * Arguments93 86 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pxin, pyin ! vector componantes 94 87 CHARACTER(len=1), INTENT( IN ) :: cd_type ! define the nature of pt2d array grid-points … … 172 165 !! 9.2 ! 07-04 (S. Masson) Add T, F points and bugfix in cos lateral boundary 173 166 !!---------------------------------------------------------------------- 174 !! * local declarations175 167 INTEGER :: ji, jj ! dummy loop indices 176 168 !! 177 169 REAL(wp) :: & 178 170 zlam, zphi, & ! temporary scalars … … 320 312 321 313 ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 322 CALL lbc_lnk 323 CALL lbc_lnk 324 CALL lbc_lnk 325 CALL lbc_lnk 314 CALL lbc_lnk( gcost, 'T', 1. ) ; CALL lbc_lnk( gsint, 'T', -1. ) 315 CALL lbc_lnk( gcosu, 'U', 1. ) ; CALL lbc_lnk( gsinu, 'U', -1. ) 316 CALL lbc_lnk( gcosv, 'V', 1. ) ; CALL lbc_lnk( gsinv, 'V', -1. ) 317 CALL lbc_lnk( gcosf, 'F', 1. ) ; CALL lbc_lnk( gsinf, 'F', -1. ) 326 318 327 319 END SUBROUTINE angle 328 320 329 321 330 SUBROUTINE geo2oce ( pxx , pyy, pzz, cgrid, &331 p lon, plat, pte, ptn , ptv)322 SUBROUTINE geo2oce ( pxx, pyy, pzz, cgrid, & 323 pte, ptn ) 332 324 !!---------------------------------------------------------------------- 333 325 !! *** ROUTINE geo2oce *** … … 344 336 !! ! 00-08 (D. Ludicone) Reduced section at Bab el Mandeb 345 337 !! 8.5 ! 02-06 (G. Madec) F90: Free form 346 !!---------------------------------------------------------------------- 347 !! * Local declarations 348 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 349 pxx, pyy, pzz 350 CHARACTER (len=1), INTENT( in) :: & 351 cgrid 352 REAL(wp), INTENT( in ), DIMENSION(jpi,jpj) :: & 353 plon, plat 354 REAL(wp), INTENT(out), DIMENSION(jpi,jpj) :: & 355 pte, ptn, ptv 338 !! 3.0 ! 07-08 (G. Madec) geo2oce suppress lon/lat agruments 339 !!---------------------------------------------------------------------- 340 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pxx, pyy, pzz 341 CHARACTER(len=1) , INTENT(in ) :: cgrid 342 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: pte, ptn 343 !! 356 344 REAL(wp), PARAMETER :: rpi = 3.141592653E0 357 345 REAL(wp), PARAMETER :: rad = rpi / 180.e0 358 359 !! * Local variables360 346 INTEGER :: ig ! 361 362 347 !! * Local save 363 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: & 364 zsinlon, zcoslon, & 365 zsinlat, zcoslat 366 LOGICAL, SAVE, DIMENSION (4) :: & 367 linit = .FALSE. 348 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 349 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 368 350 !!---------------------------------------------------------------------- 369 351 370 352 SELECT CASE( cgrid) 371 372 CASE ( 't' ) ;; ig = 1 373 CASE ( 'u' ) ;; ig = 2 374 CASE ( 'v' ) ;; ig = 3 375 CASE ( 'f' ) ;; ig = 4 376 377 CASE default 353 CASE ( 'T' ) 354 ig = 1 355 IF( .NOT. linit(ig) ) THEN 356 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 357 zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 358 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 359 zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 360 linit(ig) = .TRUE. 361 ENDIF 362 CASE ( 'U' ) 363 ig = 2 364 IF( .NOT. linit(ig) ) THEN 365 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 366 zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 367 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 368 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 369 linit(ig) = .TRUE. 370 ENDIF 371 CASE ( 'V' ) 372 ig = 3 373 IF( .NOT. linit(ig) ) THEN 374 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 375 zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 376 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 377 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 378 linit(ig) = .TRUE. 379 ENDIF 380 CASE ( 'F' ) 381 ig = 4 382 IF( .NOT. linit(ig) ) THEN 383 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 384 zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 385 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 386 zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 387 linit(ig) = .TRUE. 388 ENDIF 389 CASE default 378 390 WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 379 391 CALL ctl_stop( ctmp1 ) 380 END SELECT 381 382 IF( .NOT. linit(ig) ) THEN 383 zsinlon (:,:,ig) = SIN (rad * plon) 384 zcoslon (:,:,ig) = COS (rad * plon) 385 zsinlat (:,:,ig) = SIN (rad * plat) 386 zcoslat (:,:,ig) = COS (rad * plat) 387 linit (ig) = .TRUE. 388 ENDIF 389 390 pte = - zsinlon (:,:,ig) * pxx + zcoslon (:,:,ig) * pyy 391 ptn = - zcoslon (:,:,ig) * zsinlat (:,:,ig) * pxx & 392 - zsinlon (:,:,ig) * zsinlat (:,:,ig) * pyy & 393 + zcoslat (:,:,ig) * pzz 394 ptv = zcoslon (:,:,ig) * zcoslat (:,:,ig) * pxx & 395 + zsinlon (:,:,ig) * zcoslat (:,:,ig) * pyy & 396 + zsinlat (:,:,ig) * pzz 397 392 END SELECT 393 394 pte = - zsinlon(:,:,ig) * pxx + zcoslon(:,:,ig) * pyy 395 ptn = - zcoslon(:,:,ig) * zsinlat(:,:,ig) * pxx & 396 - zsinlon(:,:,ig) * zsinlat(:,:,ig) * pyy & 397 + zcoslat(:,:,ig) * pzz 398 !!$ ptv = zcoslon(:,:,ig) * zcoslat(:,:,ig) * pxx & 399 !!$ + zsinlon(:,:,ig) * zcoslat(:,:,ig) * pyy & 400 !!$ + zsinlat(:,:,ig) * pzz 401 ! 398 402 END SUBROUTINE geo2oce 403 404 SUBROUTINE oce2geo ( pte, ptn, cgrid, & 405 pxx , pyy , pzz ) 406 !!---------------------------------------------------------------------- 407 !! *** ROUTINE oce2geo *** 408 !! 409 !! ** Purpose : 410 !! 411 !! ** Method : Change vector from east/north to geocentric 412 !! 413 !! History : 414 !! ! (A. Caubel) oce2geo - Original code 415 !!---------------------------------------------------------------------- 416 REAL(wp), DIMENSION(jpi,jpj), INTENT( IN ) :: pte, ptn 417 CHARACTER(len=1) , INTENT( IN ) :: cgrid 418 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ) :: pxx , pyy , pzz 419 !! 420 REAL(wp), PARAMETER :: rpi = 3.141592653E0 421 REAL(wp), PARAMETER :: rad = rpi / 180.e0 422 INTEGER :: ig ! 423 !! * Local save 424 REAL(wp), SAVE, DIMENSION(jpi,jpj,4) :: zsinlon, zcoslon, zsinlat, zcoslat 425 LOGICAL , SAVE, DIMENSION(4) :: linit = .FALSE. 426 !!---------------------------------------------------------------------- 427 428 SELECT CASE( cgrid) 429 CASE ( 'T' ) 430 ig = 1 431 IF( .NOT. linit(ig) ) THEN 432 zsinlon(:,:,ig) = SIN( rad * glamt(:,:) ) 433 zcoslon(:,:,ig) = COS( rad * glamt(:,:) ) 434 zsinlat(:,:,ig) = SIN( rad * gphit(:,:) ) 435 zcoslat(:,:,ig) = COS( rad * gphit(:,:) ) 436 linit(ig) = .TRUE. 437 ENDIF 438 CASE ( 'U' ) 439 ig = 2 440 IF( .NOT. linit(ig) ) THEN 441 zsinlon(:,:,ig) = SIN( rad * glamu(:,:) ) 442 zcoslon(:,:,ig) = COS( rad * glamu(:,:) ) 443 zsinlat(:,:,ig) = SIN( rad * gphiu(:,:) ) 444 zcoslat(:,:,ig) = COS( rad * gphiu(:,:) ) 445 linit(ig) = .TRUE. 446 ENDIF 447 CASE ( 'V' ) 448 ig = 3 449 IF( .NOT. linit(ig) ) THEN 450 zsinlon(:,:,ig) = SIN( rad * glamv(:,:) ) 451 zcoslon(:,:,ig) = COS( rad * glamv(:,:) ) 452 zsinlat(:,:,ig) = SIN( rad * gphiv(:,:) ) 453 zcoslat(:,:,ig) = COS( rad * gphiv(:,:) ) 454 linit(ig) = .TRUE. 455 ENDIF 456 CASE ( 'F' ) 457 ig = 4 458 IF( .NOT. linit(ig) ) THEN 459 zsinlon(:,:,ig) = SIN( rad * glamf(:,:) ) 460 zcoslon(:,:,ig) = COS( rad * glamf(:,:) ) 461 zsinlat(:,:,ig) = SIN( rad * gphif(:,:) ) 462 zcoslat(:,:,ig) = COS( rad * gphif(:,:) ) 463 linit(ig) = .TRUE. 464 ENDIF 465 CASE default 466 WRITE(ctmp1,*) 'geo2oce : bad grid argument : ', cgrid 467 CALL ctl_stop( ctmp1 ) 468 END SELECT 469 470 pxx = - zsinlon(:,:,ig) * pte - zcoslon(:,:,ig) * zsinlat(:,:,ig) * ptn 471 pyy = zcoslon(:,:,ig) * pte - zsinlon(:,:,ig) * zsinlat(:,:,ig) * ptn 472 pzz = zcoslat(:,:,ig) * ptn 473 474 475 END SUBROUTINE oce2geo 399 476 400 477 … … 446 523 END SUBROUTINE repere 447 524 525 SUBROUTINE obs_rot ( psinu, pcosu, psinv, pcosv ) 526 !!---------------------------------------------------------------------- 527 !! *** ROUTINE obs_rot *** 528 !! 529 !! ** Purpose : Copy gsinu, gcosu, gsinv and gsinv 530 !! to input data for rotations of 531 !! current at observation points 532 !! 533 !! History : 534 !! 9.2 ! 09-02 (K. Mogensen) 535 !!---------------------------------------------------------------------- 536 REAL(wp), DIMENSION(jpi,jpj), INTENT( OUT ):: & 537 & psinu, pcosu, psinv, pcosv! copy of data 538 539 !!---------------------------------------------------------------------- 540 541 ! Initialization of gsin* and gcos* at first call 542 ! ----------------------------------------------- 543 544 IF( lmust_init ) THEN 545 IF(lwp) WRITE(numout,*) 546 IF(lwp) WRITE(numout,*) ' obs_rot : geographic <--> stretched' 547 IF(lwp) WRITE(numout,*) ' ~~~~~~~ coordinate transformation' 548 549 CALL angle ! initialization of the transformation 550 lmust_init = .FALSE. 551 552 ENDIF 553 554 psinu(:,:) = gsinu(:,:) 555 pcosu(:,:) = gcosu(:,:) 556 psinv(:,:) = gsinv(:,:) 557 pcosv(:,:) = gcosv(:,:) 558 559 END SUBROUTINE obs_rot 560 561 448 562 !!====================================================================== 449 563 END MODULE geo2ocean -
branches/TAM_V3_0/NEMO/OPA_SRC/lib_mpp.F90
r1209 r1884 110 110 INTEGER :: & 111 111 mppsize, & ! number of process 112 mpprank, & ! process number [ 0 - size-1 ] 112 mpprank ! process number [ 0 - size-1 ] 113 114 INTEGER, PUBLIC :: & 113 115 mpi_comm_opa ! opa local communicator 114 116 … … 122 124 nrank_ice ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 123 125 ! variables used in case of north fold condition in mpp_mpi with jpni > 1 124 INTEGER :: &!126 INTEGER, PUBLIC :: & ! 125 127 ngrp_world, & ! group ID for the world processors 126 128 ngrp_north, & ! group ID for the northern processors (to be fold) … … 128 130 ndim_rank_north, & ! number of 'sea' processor in the northern line (can be /= jpni !) 129 131 njmppmax ! value of njmpp for the processors of the northern line 130 INTEGER :: & !132 INTEGER, PUBLIC :: & ! 131 133 north_root ! number (in the comm_opa) of proc 0 in the northern comm 132 INTEGER, DIMENSION(:), ALLOCATABLE :: &134 INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE :: & 133 135 nrank_north ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 134 136 CHARACTER (len=1) :: & 135 137 c_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 136 LOGICAL :: &138 LOGICAL, PUBLIC :: & 137 139 l_isend = .FALSE. ! isend use indicator (T if c_mpi_send='I') 138 140 INTEGER :: & ! size of the buffer in case of mpi_bsend -
branches/TAM_V3_0/NEMO/OPA_SRC/opa.F90
r1146 r1884 67 67 USE diaptr ! poleward transports (dia_ptr_init routine) 68 68 69 USE tamtrj ! writing out state trajectory 70 69 71 USE step ! OPA time-stepping (stp routine) 70 72 #if defined key_oasis3 … … 302 304 CALL dia_ptr_init ! Poleward TRansports initialization 303 305 306 CALL tam_trj_ini 307 IF(lwp) WRITE(numout,*)'Euler time step switch is ', neuler 304 308 ! ! =============== ! 305 309 ! ! time stepping ! -
branches/TAM_V3_0/NEMO/OPA_SRC/par_oce.F90
r1152 r1884 38 38 ! ! ( <= jpni x jpnj ) 39 39 #endif 40 40 41 41 INTEGER, PUBLIC, PARAMETER :: & !: 42 42 jpr2di = 0, & !: number of columns for extra outer halo … … 58 58 #elif defined key_orca_r2 59 59 !!--------------------------------------------------------------------- 60 !! 'key_orca_r2' : global ocean : ORCA R 460 !! 'key_orca_r2' : global ocean : ORCA R2 61 61 !!--------------------------------------------------------------------- 62 62 # include "par_ORCA_R2.h90" … … 91 91 !!--------------------------------------------------------------------- 92 92 # include "par_GYRE.h90" 93 #elif defined key_pomme_r025 94 !!--------------------------------------------------------------------- 95 !! 'key_pomme_r025': regional basin : POMME025 96 !!--------------------------------------------------------------------- 97 # include "par_POMME_R025.h90" 93 98 #else 94 99 !!--------------------------------------------------------------------- -
branches/TAM_V3_0/NEMO/OPA_SRC/step.F90
r1151 r1884 111 111 USE floats ! floats computation (flo_stp routine) 112 112 113 USE tamtrj ! writing out state trajectory 114 113 115 USE stpctl ! time stepping control (stp_ctl routine) 114 116 USE restart ! ocean restart (rst_wri routine) … … 163 165 INTEGER, INTENT(in) :: kstp ! ocean time-step index 164 166 #endif 167 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zta_tmp, zsa_tmp 165 168 INTEGER :: jk ! dummy loop indice 166 169 INTEGER :: indic ! error indicator if < 0 … … 262 265 ta(:,:,:) = 0.e0 ! set tracer trends to zero 263 266 sa(:,:,:) = 0.e0 267 268 ! Saving non-linear trajectory at restart state 269 ! May not be exact for sbc and zdf parameters 270 IF( ( ln_trjwri ) .AND. ( kstp == nit000 ) ) CALL tam_trj_wri( kstp - 1 ) 264 271 265 272 CALL tra_sbc ( kstp ) ! surface boundary condition … … 293 300 294 301 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 302 ! saving ta and sa (temporary fix, please do not remove) 303 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 304 IF (ln_trjwri) THEN 305 ALLOCATE ( zta_tmp(jpi,jpj,jpk), & 306 & zsa_tmp(jpi,jpj,jpk) ) 307 zta_tmp(:,:,:) = ta(:,:,:) 308 zsa_tmp(:,:,:) = sa(:,:,:) 309 END IF 310 311 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 295 312 ! Dynamics 296 313 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< … … 353 370 IF( lk_diafwb ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 354 371 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 355 ! ! outputs 356 CALL dia_wri( kstp, indic ) ! ocean model: outputs 372 373 ! ! Outputs 374 375 376 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 377 ! restoring ta and sa (temporary fix, please do not remove) 378 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 379 IF (ln_trjwri) THEN 380 ta(:,:,:) = zta_tmp(:,:,:) 381 sa(:,:,:) = zsa_tmp(:,:,:) 382 DEALLOCATE ( zta_tmp, & 383 & zsa_tmp ) 384 END IF 385 386 ! ! Outputs 387 CALL dia_wri ( kstp, indic ) ! ocean model: outputs 388 389 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 390 ! Assimilation mode 391 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 392 393 IF( ln_trjwri ) CALL tam_trj_wri( kstp ) ! Output trajectory fields 394 357 395 ENDIF 358 396
Note: See TracChangeset
for help on using the changeset viewer.